; Disassembly of the file "ColorBAS.BIN" originally named:
; "Color BASIC (198x)(Jay Fenton)[From Proto EPROM].bin"
;
; Programmed and Commented by: Jay Fenton for Bally Manufacturing
;
; CPU Type: Z80 - for Bally and/or Astrocade Home Video Game System
;
; Created with dZ80 1.50 and a whole lot of hand editing/copying!
; Re-assembles 100% correctly with: zmac -i -m ColorBAS.ASM
;
; Dis-assembled and pasted-up by: Richard C. Degler, From Scratch
; Beginning on or about Monday, 21 of April 2008 at 07:42 PM
;
; Renamed some labels and added a very few comments in Mixed Case
;

; Source of Jay Fenton's comments is "astrobas.asm" by Adam Trionfo
; retyped from a wrapped-around paper listing with page headings of:

; TDL Z80 CP/M DISC ASSEMBLER VERSION 2.21 [overwritten by Page #]
; .MAIN. -

; Note: The only text in "bally_basic_souce_pages_01-32.pdf" was:

; > Bally BASIC Interpreter
; >
; > © July 1978 Bally Mfg.
; > © December 1980 Revised
; >
; > Written by Jay Fenton

; and:

; > This page left blank for double-sided printing purposes.


; Part Two - Assembly Code for the file "ColorBASIC (listing).ASM"
; Programmed by: Jay Fenton for Bally Manufacturing [see Part One]
;
; Reverse-source code found by Brett Bilbrey - "Bally Basic (1979)"
; Loose Leaf paper listing Scanned and saved as PDF by Adam Trionfo
; moved to Bally Alley Yahoo! user group dated Friday, May 15, 2009
;
; Comments (ONLY) then retyped by: Richard C. Degler, From Scratch
; Beginning on Memorial Day Eve Sunday, 24 of May 2009 at 02:24 PM
;

; To match the style (and only where useful) these are marked by ;*
; Author Unknown, but no LC decenders listing had page headings of:
;
; CROMEMCO CDOS Z80 ASSEMBLER version 02.15                  PAGE 0001
; Bally Tiny Basic        8/25/79

; [without leading semi-colons used here] and a program identifier:
;
;                   0002 ;************************************************
;                   0003 ;*                                              *
;                   0004 ;*              Bally Tiny Basic                *
;                   0005 ;*                                              *
;                   0006 ;*                  8/25/79                     *
;                   0007 ;*                                              *
;                   0008 ;************************************************
;                   0009 ;
;
; [End of Header]


;
; Here then is:

; ***************************
; * BALLY BASIC INTERPRETER *    [Comments WERE for Astro Basic]
; *                         *    [so ignore changes to comments]
; * (C) JULY 1978 BALLY MFG *    [; * (C) DEC 1980 REVISED    *]
; *                         *
; * WRITTEN BY: JAY FENTON  *
; *                         *
; * PALO ALTO TINY BASIC BY *
; * LICHEN WANG             *
; *                         *
; ***************************
; TINY BASIC INTERPRETER  [with original 300 baud tape interface]
;
        NOLIST
        INCLUDE "HVGLIB.H"      ; HOME VIDEO GAME LIBRARY
;
; MACROS
TOKEN   MACRO   TINDX, TGOTO
        DB      TINDX
        DEFF    TGOTO
        ENDM

ITEM    MACRO   STRANG, JUMPTO  ; Quoted Character
        DB      'STRANG'
        DEFF    JUMPTO
        ENDM

DEFF    MACRO   WORDY          ;* Jump table entry
        DB      (WORDY >> 8) | $80
        DB      WORDY & $FF
        ENDM

TSTC    MACRO   CAT, DOG
        RST     $08
        DB      'CAT'          ;* Char. to check
        DB      (DOG - $)-1    ;* Jump bias if no match
        ENDM

TSTCC   MACRO   CAT1, DOG1
        RST     $08
        DB      CAT1           ;* Char. to check
        DB      (DOG1 - $)-1   ;* Jump bias if no match
        ENDM

;           Defines
EDKEY   EQU     $01
CR      EQU     $0D
RUBOUT  EQU     $1F
COMMA   EQU     $2C
NLLN    EQU     $67
;
; EQUATES FOR RESTART INSTRUCTIONS
RSTEXP  EQU     $10             ; EXPR - Get EXPRession restart  ;* Evaluate expression
RSTOUT  EQU     $18             ; OUTC - OUT Char [became LDE - LoaD A, from (DE) in ab]
RSTIGN  EQU     $20             ; IGNBLK - IGNore BLanKs  ;* Get next non-blank from (DE)
RSTPAR  EQU     $28             ; PARN - expression in PAReNthesis  ;* Get value in ()
RSTFIN  EQU     $30             ; FINISH - Routine FINISH  ;* cr. or ; otherwise, WHAT?
;
BOTROM  EQU     FIRSTC          ; $2000
;
; Scratchpad area:
BOTRAM  EQU     $4000           ; [NON-INTERLACED for 4-color display]
TXT     EQU     BOTRAM + $0A00  ; [was TEXT originally] Text Array Area 
DFTLMT  EQU     TXT + $03FC     ; [Hidden Bottom of screen $4A00 to $4DFC]
; [This is why Color Basic runs faster even with EIGHT interrupts/screen!]
; [And the reason SZ is only 1020 bytes, plus 2 bytes for EOProgram marker [??counts??]]
;
BOTSCR  EQU     $4E00           ; BOTtom of SCReen [is actually end of TeXT+4]
TAPINS  EQU     BOTSCR         ;* TAPe INSert pointer
TAPEXT  EQU     $4E01          ;* TAPe EXTract pointer
TAPBUF  EQU     $4E02           ; [48 bytes of TAPe input BUFfer]
TXTUNF  EQU     $4E32          ;* "End of Basic Pgm" address [plus 2 is a -1 ??]
VDMNLF  EQU     $4E34           ; VDM NEW LINE FLAG
KEYTMR  EQU     $4E35           ; KEYBOARD SCAN TIMER  ;* Key release timer (60 Hz)
MUZTMR  EQU     $4E36           ; MUSIC NOTE TIMER  ;* Time remaining on current note
NEWTMR  EQU     $4E37           ; NEW MUSIC TIMER VALUE  ;* Time for next note
MUZMO   EQU     $4E38           ; MASTER OSC FOR DICK  ;* Master sound divider value
MUZTON  EQU     $4E39           ; TONE VALUE  ;* Next note to output
SHARPF  EQU     $4E3A           ; SHARP-FLAT
;
PIXVAL  EQU     $4E3B           ; PIXel VALue TO DRAW WITH
MNMX    EQU     $4E3C           ; MiN - MaX DELTAS FOR VECTOR DRAW
INCRO   EQU     $4E3E           ; COORDINATE INCRements FOR VECTOR DRAW
NLLNLN  EQU     $4E40           ; AUTO LINE # STUFF
NLLNCT  EQU     $4E42
NLLNZS  EQU     $4E43           ; AUTO LINE NUMBER Zero Suppress FLAG
OLDLN   EQU     $4E44           ; PREVIOUS LINE # TYPED (used for GO+10)
ALTFON  EQU     $4E46           ; 7 byte ALTernate FONt descriptor
                               ;* Character Spec Table
; ??  EQU     $4E4C            ;* [+6 ??] Indexes VRBL storage area
KEYTRK  EQU     $4E4D           ; KEYpad debounce TRacKer  ;* Last calc. input
;
VARBGN  EQU     $4E4E           ; One-letter variables (two bytes each)
DEVVAR  EQU     $4E82           ; Two-letter DEVICES VARIABLES thusly:
DEVCL0  EQU     DEVVAR          ; BC = [Character] Background (default Color 0)
DEVCL1  EQU     $4E84           ; FC = [Character] Foreground (default Color 1)
DEVTEM  EQU     $4E86           ; NT = TEMPO Note Timer (default 31 ??)
VDMX    EQU     $4E88           ; CX = VDM X COORDINATE (default -77)
VDMY    EQU     $4E8A           ; CY = VDM Y COORDINATE (default 28 [bb/ab $28])
OLDXY   EQU     $4E8C           ; XY = PREVIOUS COORDINATES FROM VECTOR DRAW
REMAIN  EQU     $4E8E           ; RM = REMAINDER FROM LAST DIVIDE
;
CLREND  EQU     $4E90    ; Flag for colors disable [New for Color Basic]
LINPAL  EQU     $4E92    ; Color Palette to use for Lines 1 through 8 array
PALCLR  EQU     $4E9A    ; Base Address for Four-Color Palettes 1 through 8
LINCNT  EQU     $4EBA    ; Current Line 0 through 8 for Interrupts
SCNLIN  EQU     $4EBB    ; Current Interrupt Line Number [New for Color Basic]
;
CHMODE  EQU     $4EBC          ;* I/O flag 0=KBD in, VID out
                               ;*          1=TAP in, VID out
                               ;*          2=KBD in, TAP out
                               ;*          6=KBD in, TAP out
                               ;*                    (expanded)
CURRNT  EQU     $4EBD           ; CURReNT line
STKGOS  EQU     $4EBF           ; STacK for GOSub
STKINP  EQU     $4EC1           ; ??
VARNXT  EQU     STKINP         ;* "NEXT" VRBL address
LOPVAR  EQU     $4EC3           ; FOR VARiable  ;* "FOR" VRBL address
LOPINC  EQU     $4EC5           ; FOR STEP  ;* "STEP" VRBL address
LOPLMT  EQU     $4EC7           ; FOR TO  ;* "TO" VRBL address
LOPLN   EQU     $4EC9           ; LOoP Line Number  ;* Line # of current FOR loop
LOPPT   EQU     $4ECB           ; 3 bytes LOoP PoinTer  ;* Current FOR line text pointer
;
BUFFER  EQU     $4ECE           ; line input BUFFER  ;* Keyboard input buffer
BUFEND  EQU     $4F36           ; BUFfer END (104 Characters)
; ?? unused block of 32 bytes ??
STKLMT  EQU     $4F56           ; STacK LiMiT (153 bytes available)
TOPSCR  EQU     RANSHT          ; $4FEF used for Top of Stack
STACKP  EQU     TOPSCR          ; Initialized STACK Pointer
;

        LIST
        ORG     BOTROM

        JP      BEGIN           ; ** AUTOSTART CASSETTE **

PIXTBL:                        ;* Masks for picture data (PX)
        DB      $C0             ; [Wider than bb or ab]
        DB      $30
        DB      $0C
        DB      $03

; TRANSFER VECTORS TO RESTART ROUTINES
        JP      TSTCH           ; * RST $08

        JP      EXPR            ; * RST RSTEXP  ;* Evaluate expression

        JP      OUTC            ; * RST RSTOUT  [became LDE  ; * RST RSTLDE in ab ??]

        JP      IGNBLK          ; * RST RSTIGN  ;* Get next non-blank from (DE)

        JP      PARN            ; * RST RSTPAR  ;* Get value of () or storage adrs

        POP     AF              ; * RST RSTFIN  ;* cr. or ; otherwise, WHAT?
        JP      FINISH

; external Transfer Vector to get a character from cassette tape into A
L201A:  JP      CHKIO           ; use TV=CALL 8218  from Basic Program [same as bb]

CLRTBL: DB      $00             ; Color Indexes ?? [New for cb]
        DB      $55
        DB      $AA
        DB      $FF

; INITIAL VALUES FOR PARAMETER VECTOR  ;* Following is moved to DEVVAR at $4E82
INIDEV:
        DW      $0000           ; [Character] BACKGROUND COLOR  ;* BC preset-Color 0
        DW      $0001           ; [Character] FOREGROUND COLOR  ;* FC preset-Color 1
        DW      $001E           ; MUSIC TEMPO  ;* NT preset
INIVDM:
        DW      $FFB3           ; (-77) VDM X COORDINATE  ;* CX preset
        DW      $001C           ; (28) VDM Y COORDINATE  ;* CY preset
        DW      $0000           ; OLDXY COORDINATE  ;* XY preset

; Text Strings
CBASIC: DB      'COLOR BASIC',CR

WHAT:   DB      'WHAT?',CR

HOW:    DB      'HOW?',CR

SORRY:  DB      'SORRY',CR

; TABLE GIVING JUMP TO ADDRESS FOR COMMANDS
TOKJT:
        DW      LISTCOM         ; 68 - 'LIST' COMmand routine
        DW      CLRSCR          ; 69 - 'CLEAR'
        DW      RUN             ; 6A - 'RUN'
        DW      NEXT            ; 6B - 'NEXT'
        DW      LINEDR          ; 6C - 'LINE'
        DW      IFF             ; 6D - 'IF'
        DW      GOTO            ; 6E - 'GOTO'
        DW      GOSUB           ; 6F - 'GOSUB'
        DW      RETURN          ; 70 - 'RETURN'
        DW      BOXDRW          ; 71 - 'BOX'
        DW      FOR             ; 72 - 'FOR'
        DW      INPUT           ; 73 - 'INPUT'
        DW      PRINT           ; 74 - 'PRINT'
        DW      COLOR           ; 75 - 'COLOR' [New for Color Basic]
        DW      CLINE           ; 76 - 'CLINE' [New for Color Basic]

; INTERRUPT VECTOR ITEMS
        DW      LPINT           ; (ITAB & $FFF0) Light Pen INTerrupt vector

ITAB:   DW      TBIINT          ; Tiny Basic Interpreter INTerrupt vector

; TABLE GIVING ASCII CHARS FOR TOKENS with last character marked negative
TOKTXT:
        DB      'LIS'
        DB      'T' + $80       ; ($68) "LIST" Text
        DB      'CLEA'
        DB      'R' + $80       ; ($69) "CLEAR"
        DB      'RU'
        DB      'N' + $80       ; ($6A) "RUN"
        DB      'NEX'
        DB      'T' + $80       ; ($6B) "NEXT"
        DB      'LIN'
        DB      'E' + $80       ; ($6C) "LINE"
        DB      'I'
        DB      'F' + $80       ; ($6D) "IF"
        DB      'GOT'
        DB      'O' + $80       ; ($6E) "GOTO"
        DB      'GOSU'
        DB      'B' + $80       ; ($6F) "GOSUB"
        DB      'RETUR'
        DB      'N' + $80       ; ($70) "RETURN"
        DB      'BO'
        DB      'X' + $80       ; ($71) "BOX"
        DB      'FO'
        DB      'R' + $80       ; ($72) "FOR"
        DB      'INPU'
        DB      'T' + $80       ; ($73) "INPUT"
        DB      'PRIN'
        DB      'T' + $80       ; ($74) "PRINT"
        DB      'COLO'
        DB      'R' + $80       ; ($75) "COLOR" [New for Color Basic]
        DB      'CLIN'
        DB      'E' + $80       ; ($76) "CLINE" [New for Color Basic]
        DB      'STE'
        DB      'P' + $80       ; ($77) "STEP" [was $75 in bb/ab]
        DB      'RN'
        DB      'D' + $80       ; ($78) "RND" [was $76 in bb/ab]
        DB      'T'
        DB      'O' + $80       ; ($79) "TO" [was $77 in bb/ab]

; DEVICE VARIABLE TABLE /* Special 2-letter variables
; THIS TABLE IS IN INVERSE ORDER OF APPEARENCE IN MEMORY
PARNUM  EQU     7
DEVLST:                         ; [has first character minus $40 for ?? why??]
        DB      'R' - '@'
        DB      'M'             ; "RM" = ReMainder from last divide
        DB      'X' - '@'
        DB      'Y'             ; "XY" = Location from last draw
        DB      'C' - '@'
        DB      'Y'             ; "CY" = Character print Y
        DB      'C' - '@'
        DB      'X'             ; "CX" = Character print X
        DB      'N' - '@'
        DB      'T'             ; "NT" = Note Tempo
        DB      'F' - '@'
        DB      'C'             ; "FC" = character Foreground Color
        DB      'B' - '@'
        DB      'C'             ; "BC" = character Background Color

; TINY BASIC INTERRUPT ROUTINE
;* NORMAL INTERRUPT PROCESSOR
;
TBIINT: PUSH    AF              ; SAVE REGISTERS
        PUSH    BC
        PUSH    DE
        PUSH    HL
; DEAL WITH KEYBOARD SCAN TIMER     [Totally NOT like bb OR ab ??]
        LD      A,(CLREND)
        OR      A               ; Disable Color Interrupts ?
        JR      NZ,TBIN3
        LD      A,(LINCNT)      ; Current Text Line
        INC     A
        CP      $08
        JR      NZ,TBIN1
        XOR     A
TBIN1:  LD      (LINCNT),A
        CALL    SETCLR          ; do SET CoLoRs
        LD      A,(SCNLIN)      ; Read old Int LINE number
        ADD     A,$10           ; Increment Int LINE number by 16
        CP      $80
        JR      C,TBIN2
        LD      A,$0C           ; Reset Interrupt LINE number to 12
TBIN2:  LD      (SCNLIN),A      ; Save new Int LINE number
        OUT     (INLIN),A       ; &($0F)=$0C, $1C, $2C, $3C, $4C, $5C, $6C, $7C
TBIN3:  LD      HL,KEYTMR
        LD      A,(HL)         ;* Get key release timer
        AND     A
        JR      Z,TBIN4        ;* Jp if already zero
        DEC     (HL)            ; Count KEYTMR down to Zero
TBIN4:  INC     HL              ; Point to MUZTMR
; HAS MUSIC TIMER COUNTED DOWN?
        LD      A,(HL)
        AND     A
        JR      Z,TBIN5         ; YEP - PLAY NEXT NOTE
        DEC     (HL)            ; ELSE DECREMENT IT
        JR      NZ,INTDON       ; JUMP IF NOT NOW ZERO
        XOR     A
        OUT     (TONEA),A
        JR      TBINX           ; Silence A Stacato

; MUSIC TIMER IS AT ZERO - ARE NEW PARAMETERS READY?
TBIN5:  INC     HL              ; STEP TO NEW TIMER VALUE
        OR      (HL)            ; IS IT NON ZERO?
        JR      Z,INTDON        ; JUMP IF NOT
        DEC     HL              ; ELSE SET OFFICIAL TIMER
        LD      (HL),A          ; SAY WE GOT IT
        INC     HL
        LD      (HL),$00
        INC     HL
        LD      A,(HL)          ; SET NEW MASTER
        OUT     (TONMO),A
        LD      (HL),OA2        ; Restore Center Octave = 71
        INC     HL
        LD      A,(HL)          ; AND NEW TONE
        OUT     (TONEA),A
        AND     A               ; REST WANTED?
        JR      Z,INTDON        ; YES - JUMP AROUND VOLUME UPDATE
        LD      A,$0F
TBINX:  OUT     (VOLAB),A
; DONE - RESTORE REGISTERS AND GO BACK
INTDON: POP     HL
        POP     DE
        POP     BC
        JR      LPIEX

;************************************************
;*      Light pen interrupt processor           *
;************************************************
;
LPINT:  PUSH    AF
        EXX
        IN      A,(SW2)        ;* Collect at least 4 1s to start
        RRA                    ;* Then wait on a 0 (Start bit)
        LD      A,C            ;* Collect 8 bits, then wait for
        RRA                    ;*  another start bit.
        LD      C,A            ;* Move old data to hi C
        LD      A,B
        AND     A
        JP      M,LPIN1        ;* Minus means collecting 4 1s
        JR      NZ,LPIN2       ;* NZ means collecting data
        BIT     7,C            ;* Else waiting on start bit
        JR      NZ,LPIN3       ;* Leave unless start bit found
        LD      B,$08          ;* Now collect 8 data bits
        JR      LPIN3

LPIN1:  INC     B              ;* Increment 1 collector
        BIT     7,C
        JR      NZ,LPIN3       ;* Good if a 1
        LD      B,$FC          ;* Else reset collector
        JR      LPIN3

LPIN2:  DJNZ    LPIN3          ;* Leave unless 8 bits collected
        LD      HL,(TAPINS)
        LD      A,L            ;* Get insert pointer
        CALL    RAMPIT         ;* Update for next
        CP      H
        JR      Z,LPIN3        ;* Buffer is jammed; forget it!
        LD      (TAPINS),A     ;* Save insert pointer
        LD      H,TAPBUF >> 8   ; $4E [point back to $4E00+TAPINS]
        LD      (HL),C
LPIN3:  EXX
LPIEX:  POP     AF
        EI
        RET

; [New for ColorBasic] Set Color Registers [should be before LPINT ??]
;
SETCLR: LD      E,A
        LD      HL,LINPAL       ; Base address for Line 1 - 8 Palettes
        LD      D,$00
        ADD     HL,DE
        LD      A,(HL)
        ADD     A,A
        ADD     A,A
        LD      E,A
; SET COLOR REGISTERS TO VALUES IN Color Table plus Color Offset
        LD      HL,PALCLR       ; Base address for Color Palettes  1 - 8
        ADD     HL,DE
        LD      A,(HL)
        OUT     (COL0L),A
        INC     HL
        LD      A,(HL)
        OUT     (COL1L),A
        INC     HL
        LD      A,(HL)
        OUT     (COL2L),A
        INC     HL
        LD      A,(HL)
        OUT     (COL3L),A
        RET

; Ramp pointer and reset to start of TAPe BUFfer if past end
;
RAMPIT: INC     A
        CP      TXTUNF & $FF    ; not to TAPBUF+$30 yet ?
        RET     NZ
        LD      A,TAPBUF & $FF
        RET

;* Prepare for tape input [and turn off cursor]
;
;* :INPUT, :LIST and :RUN call this routine
;
TVLLNK: DI
        LD      HL,$2222        ; should be (TAPBUF & $FF) + ((TAPBUF & $FF) << 8)
        LD      (TAPINS),HL     ; sets both pointers into buffer [$0202 to start!]
        EXX
        XOR     A
        LD      (DEVTEM),A     ;* No notes
        INC     A
        LD      (CHMODE),A
        LD      B,$FC
        EXX
        LD      A,$18           ; Screen AND LightPen Interrupts
        OUT     (INMOD),A
        EI
        RST     RSTIGN         ;* Get next non-blank from (DE)
        CALL    ZONATNL         ; do Zero ON AT NewLine or ;
        RET     Z
        CALL    EXPR            ; Same as RST RSTEXP  ;* Evaluate expression
        PUSH    DE
TVL1:   PUSH    HL
        CALL    CHKIO          ;* Get tape character
        POP     HL
TVL2:   CP      H
        JR      NZ,TVL1
        PUSH    HL
        CALL    CHKIO          ;* Get tape character
        POP     HL
        CP      L
        JR      NZ,TVL2
        POP     DE

; SUBROUTINE TO RETURN ZERO STATUS IF CHARACTER IN A
; IS NL OR ';'  [ab combined with RSTIGN for IGNATNL]
;
ZONATNL:
        CP      ';'             ; CHECK FOR CONTINUATION
        RET     Z
        CP      CR              ; AND FOR CR
        RET

; ENTRY TO LOAD PROGRAM [NOT ab COMBINED SCREEN AND PGM]
; note: Pressing ANY KEY will cancel the tape input mode
;
; :INPUT COMMAND  ;* - Load BASIC program into memory
; Any characters read in from tape will display on TV
; and be executed as if they were input by the KeyPad.
;
TINPUT: CALL    TVLLNK          ; [ab only ?? AND ARGS?]  do OPEN for Tape Input
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; :LIST command  ;* - List BASIC tape
; note: displays information on tape WITHOUT saving to memory
;
TVLIST: CALL    TVLLNK          ; do Prepare for Tape Input
TVLIL:  CALL    CHKIO           ; do Read a character from cassette tape
        RST     RSTOUT         ;* Output Char. in A
        JR      TVLIL

; *PRINT character print routine  ;* - Print BASIC program onto printe
;
POUTPU: LD      A,$06
        DB      $01             ; does a LD BC,$023E instead of LD A,$02
;* Skips 2 bytes
; :PRINT character print routine  ;* - Print BASIC program to tape
;
TOUTPU: DB      $3E             ; does a LD A,$02
        DB      $02
        LD      (CHMODE),A
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; :RUN COMMAND - LOADS 128 byte BOOTSTRAP INTO RAM
; AND JUMPS TO IT  ;* - Load tape to $4000-$407F and execute
;
TLOAD:  CALL    TVLLNK          ; do Prepare for Tape Input
        LD      HL,NORMEM       ; HL=SCREEN TOP
        PUSH    HL
; SUBROUTINE TO INPUT A BLOCK, HL=STORE ADDR
; FIRST - AN ENTRY TO REVEAL FEEDBACK AREA
;
INBLK:  PUSH    HL
        CALL    CHKIO           ; do Read a character from cassette tape
        POP     HL
        LD      (HL),A
        INC     HL
        BIT     7,L
        JR      Z,INBLK
        RET

; FUNCTION TO RETURN STATE OF ADDRESSED PIXEL
; IE... PIX(X,Y)= 1 IF PIXEL IS 1, 0 IF 0
;
;* PX - Check screen dot
;* PX(<expr1>,<expr2>)
;
PIXFUN: TSTC    '(',PIXDUD     ;* Open = Char. to check, Jump if no match
        PUSH    BC
        RST     RSTEXP         ;* Evaluate expression
        PUSH    HL             ;* Save value of <expr1>
        TSTCC   COMMA,PIXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        TSTC    ')',PIXDUD     ;* Close = Char. to check, Jump if no match
        POP     BC             ;* X value
        PUSH    DE              ; SAVE PTR  ;* Save text pointer
        LD      D,L            ;* D = Y
        LD      E,C            ;* E = X
        CALL    R2ABS          ;* Get odd crt adrs to A
        EX      DE,HL          ;* and adrs to DE
        SYSSUK  INDEXB          ; INDEX BYTE (SYSTEM SUBROUTINE)
        DW      PIXTBL          ; HL + A [not loaded!] to HL

        LD      A,(DE)          ; GET BYTE FROM SCREEN  ;* Get CRT dots
        AND     (HL)            ; MASK OFF NONSENSE  ;* AND with mask
        LD      H,$00
        LD      L,H
        POP     DE
        POP     BC              ;* No dot
        RET     Z
        INC     HL
        RET                     ;* Dot on

; SUBROUTINE TO GET VARIABLE MAKING SURE IT IS ONE
;
TSTVFF: CALL    TSTV           ;* Get VRBL storage address
        RET     NC              ; GO BACK IF GOOD  ;* Was a variable
; ELSE FALL INTO...
PIXDUD: JP      QWHAT

; BOX DRAW ROUTINE  ;* - Draw a box on the screen
;* BOX(<x>,<y>,<xsize>,<ysize>,<type>)
;
BOXDRW: RST     RSTEXP          ; GET X  ;* Evaluate expression
        PUSH    HL             ;* Save starting x
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP          ; GET Y  ;* Evaluate expression
        PUSH    HL             ;* Save starting y
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        CALL    GETOK          ;* Get Expr., Range 1-255 [0 asks HOW?]
        PUSH    AF             ;* Save xsize
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        CALL    GETOK          ;* Get Expr., Range 1-255 [0 asks HOW?]
        PUSH    AF             ;* Save ysize
        TSTCC   COMMA,BOXDUD   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Get box type  ;* Evaluate expression
        PUSH    DE             ;* Save text pointer
        POP     IX             ;*  in IX
        POP     AF              ; RESTORE YS
        LD      B,A            ;* Get ysize to B [ab just uses POP BC !]
        POP     AF              ; AND XS
        LD      C,A            ;* Get xsize to C
        LD      A,L             ; PRESERVE FLAG  ;*  Get box type to A
        POP     HL
        LD      D,L            ;* Get start y to D
        POP     HL
        LD      E,L            ;* Get start x to E
        LD      L,A
; NOW WE HAVE: B=YS, C=XS, D=Y, E=X, L=FLAG
; LIMIT CHECK Y
        LD      H,B
        DEC     H
        SRL     H
        LD      A,D
        CALL    SABS            ; do Set to ABSoulte value
        ADD     A,H
        CP      $20             ; [bb uses $2C, ab uses $2D ??]
        JR      NC,BOXNDR
        LD      A,D
        ADD     A,H
        LD      D,A
; AND X
        LD      H,C
        SRL     H
        LD      A,E
        CALL    SABS            ; do Set to ABSoulte value
        ADD     A,H
        CP      $51
        JR      NC,BOXNDR
        LD      A,E
        SUB     H
        LD      E,A
; DIDDLE WITH FLAG BYTE [to a byte of color 0,1,2,or 3 with NO X-ORing !]
        LD      A,L
        AND     $03             ; MODULO 4  [Color Basic only]
        PUSH    DE              ; A is INDEX into Color Index Table
        SYSSUK  INDEXB          ; HL + A [not loaded!] to HL
        DW      CLRTBL          ; $00,$55,$AA,$FF for Line Color

        POP     DE
        PUSH    AF
        CALL    R2ABS           ; do Relative TO ABSoulte conversion
; HL = ABS ADDR, A = SA, B=YS, C=XS
        OUT    (MAGIC),A
        POP     AF
        CALL    BOXPUT          ; do draw a BOX PUT on screen
BOXNDR:
        PUSH    IX
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

BOXDUD: JP      QWHAT

; Set A to ABSoulute value
;
SABS:   AND     A
        RET     P
        NEG
        RET

; SUBROUTINE TO DRAW A BOX ON SCREEN
;
BOXPUT: LD      E,A
        LD      A,C             ; D = X / 4
        RRCA
        RRCA
        AND     $3F
        INC     A
        LD      D,A
; PAINT FULL BOX STRIPES
MPT1:   DEC     D
        JR      Z,MPT2
        LD      A,11111111B     ; $FF [bb and ab used $AA]
        CALL    STRIPE          ; do draw a STRIPE on screen
        JR      MPT1

MPT2:   LD      A,C
        AND     $03
        INC     A
        LD      C,A
        XOR     A
MPT3:   DEC     C
        JR      Z,MPT4
        RRCA
        RRCA
        OR      11000000B       ; $C0 [bb and ab used $80]
        JR      MPT3

MPT4:   CALL    STRIPE          ; do draw a STRIPE on screen
        XOR     A
; FALL INTO...
; SUBROUTINE TO PAINT A STRIPE
;
STRIPE: PUSH    HL
        PUSH    BC
        PUSH    DE
        LD      (WASTER),A
        LD      A,(WASTER + $4000)
        LD      C,A
        AND     E
        LD      E,A
        LD      A,C
        CPL
        LD      C,A
STRP1:  LD      A,(HL)
        AND     C
        OR      E
        LD      (HL),A
        LD      A,L
        ADD     A,$28
        LD      L,A
        LD      A,H
        ADC     A,$00
        LD      H,A
        DJNZ    STRP1
        POP     DE
        POP     BC
        POP     HL
        INC     HL
        RET

GETOK:  RST     RSTEXP         ;* Evaluate expression
        LD      A,H
        OR      A
        JR      NZ,LINEDX      ;* Jp if over 255
        OR      L
        JR      Z,LINEDX       ;* Jp if = 0
        RET

; LINE DRAWER  ;* - Draw a line on the screen
;* LINE(<x>,<y>,<type>)
;
LINEDR: RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        PUSH    AF             ;* Save starting x
        TSTCC   COMMA,LINEDX   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        PUSH    AF             ;* Save starting y
        TSTCC   COMMA,LINEDX   ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        PUSH    DE
        POP     IX
        LD      A,L
        AND     $03             ; MODulo 4 [new for cb]
        SYSSUK  INDEXB          ; HL + A [not loaded!] to HL
        DW      CLRTBL

        LD      (PIXVAL),A      ; SET PIXVAL
        LD      DE,(OLDXY)     ;* Current xy [Y is high order byte, X is lower byte]
        POP     AF
        LD      H,A
        POP     AF
        LD      L,A
        CALL    RANG1            ; do check the RANGe of CX
        JR      NC,LINED1      ;* Jp if out of range
        LD      A,H
        CALL    RANG2            ; do check the RANGe of CY
        JR      NC,LINED1      ;* Jp if out of range
        LD      (OLDXY),HL      ; SET NEW LAST PLACE  ;* Update xy
        NOP
        NOP                     ; [don't DIDDLE WITH FLAG BYTE or SET PIXVAL]
        CALL    DVECT           ; do Draw line VECTor
LINED1: PUSH    IX
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

LINEDX: JP      QHOW

; LARRY LIVERMORE'S VECTOR DRAWING ALGORITHM
; H=Y1, L=X1, D=Y2, E=X2
;
DVECT:  PUSH    DE
        LD      B,L
        LD      C,E
        CALL    CDELTA          ; do Compute DELTA for X
        LD      E,B
        LD      L,C
        LD      B,H
        LD      C,D
        CALL    CDELTA          ; do Compute DELTA for Y
        LD      H,C
        LD      D,B
; NOW WE HAVE: H=SGN(DY), L=SGN(DX)
; D=ABS(DY), E=ANS(DX)
        LD      (INCRO),HL
; DECIDE WHICH DELTA IS LARGER
; CALL  BIGGER MX, SMALLER MN
        LD      C,$00
        LD      A,D
        CP      E
        JR      C,VECT1
        LD      D,E
        LD      E,A
        INC     C
VECT1:  LD      A,D             ; MX TO A
        SRL     A
        LD      B,A
        EX      DE,HL
        LD      (MNMX),HL
        POP     DE
        LD      A,L
        INC     A               ; MAKE SURE LAST PIXEL WRITTEN
; THE INFAMOUS PIXEL PAINTING LOOP
VECT2:  PUSH    AF
        CALL    R2ABS           ; do Relative TO ABSoulte conversion
        PUSH    BC
        PUSH    HL
        LD      C,A
        LD      B,$00
        LD      HL,PIXTBL
        ADD     HL,BC
        LD      B,(HL)
        POP     HL
        LD      A,B
        CPL
        LD      C,A
        LD      A,(PIXVAL)
        AND     B
        LD      B,A
        LD      A,(HL)
        AND     C
        OR      B
        LD      (HL),A
        POP     BC
; INCREMENT COORDINATES
        LD      HL,(MNMX)
        LD      A,B
        ADD     A,H
        CP      L
        JR      C,VECT4
        SUB     L
        LD      B,A
        LD      HL,(INCRO)
        LD      A,D
        ADD     A,H
        LD      D,A
VECT3:  LD      A,E
        ADD     A,L
        LD      E,A
        JR      VECT5

VECT4:  LD      B,A
        LD      HL,(INCRO)
        LD      A,C
        RRCA
        JR      NC,VECT3
        LD      A,D
        ADD     A,H
        LD      D,A
; END OF LOOP
VECT5:  POP     AF
        DEC     A
        JR      NZ,VECT2
        RET

RANG1:  CP      $50            ;* Check CX range [-80 to 79]
        RET     C
        CP      $B0
        CCF
        RET

RANG2:  CP      $20            ;* Check CY range [-32 to 31 [bb was -44 to 43]]
        RET     C
        CP      $E0             ; [bb was $D4]
        CCF
        RET

; SUBROUTINE TO LOAD HL WITH VDM COORDINATES
; FROM DEVICE VARIABLES
;
LDVDMC: PUSH    AF
        LD      A,(VDMY)
        CPL
        ADD     A,$1D           ; [bb and ab use $29 ??]
        CP      $39             ; OUT OF RANGE?  [bb and ab use $51 ??]
        JR      C,LDVDM1        ; NO
        XOR     A
LDVDM1: LD      H,A
        LD      A,(VDMX)        ; DIDDLE WITH X
        ADD     A,$4D
        CP      $9D
        JR      C,LDVDM2
        XOR     A
LDVDM2: LD      L,A
        POP     AF
        RET

; SUBROUTINE TO STORE HL INTO VDM COORDINATE DEVICE VARIABLES
;
STVDMC: PUSH    HL
        LD      A,H
        SUB     $1D             ; [bb ab uses $29 ??]
        CPL
        LD      L,A
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        LD      (VDMY),HL      ;* Update CY
        POP     HL
        LD      A,L
        SUB     $4D
        LD      L,A
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        LD      (VDMX),HL      ;* Update CX
        RET

; SUBROUTINE TO COMPUTE DELTA AND INCREMENT FOR TWO COORDINATES
;
CDELTA: PUSH    HL
        PUSH    DE
        LD      L,C
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        EX      DE,HL
        LD      L,B
        CALL    SGNEXT          ; do SiGN EXTend from L into H
        XOR     A
        SBC     HL,DE
; COMPUTE SGN(DELTA) AND ABS(DELTA)
        OR      H
        JR      Z,CDELT1
        LD      C,A
        LD      A,L
        NEG
        LD      B,A
        JR      CDELT3

CDELT1: OR      L               ; POS CASE 0?
        JR      Z,CDELT2
        LD      A,$01
CDELT2: LD      B,L
        LD      C,A
CDELT3: POP     DE
        POP     HL
        RET

; ...
; RELATIVE TO ABSOLUTE CONVERSTION
;
R2ABS:  PUSH    DE             ;* Save XY
        LD      A,D            ;* Get y
        CPL                    ;* Reverse sense
        ADD     A,$20          ;* Make it 0-63 [bb and ab use $2C for 0-87]
        LD      D,A            ;* Put it back
        LD      A,E
        ADD     A,$50          ;* Same for x [0-159]
        LD      E,A
        XOR     A
        SYSTEM  RELAB1         ;* Get CRT adrs to DE

        EX      DE,HL
        POP     DE             ;* Regain original XY
        RET

; Set Palette Color  [New for Color Basic ?? Needs comments ??]
;
COLOR:  RST     RSTEXP         ;* Evaluate expression
        PUSH    HL
        TSTCC   COMMA,CLREX    ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        PUSH    HL
        TSTCC   COMMA,CLREX    ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        PUSH    HL
        TSTCC   COMMA,CLREX    ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        PUSH    HL
        TSTCC   COMMA,CLREX    ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        PUSH    DE
        POP     IX
        LD      E,L
        POP     HL
        LD      D,L
        POP     HL
        LD      C,L
        POP     HL
        LD      B,L
        POP     HL
        DEC     HL
        LD      A,L
        SUB     $08
        JR      NC,CLREX
        PUSH    DE
        LD      A,L
        ADD     A,A
        ADD     A,A
        LD      E,A
        LD      D,$00
        LD      HL,PALCLR       ; Base address for Color Palettes 1 - 8
        ADD     HL,DE
        POP     DE
        LD      (HL),B
        INC     HL
        LD      (HL),C
        INC     HL
        LD      (HL),D
        INC     HL
        LD      (HL),E
        PUSH    IX
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

CLREX:  JP      LINEDX

; Set Text Line Palette  [New for Color Basic ?? Needs comments]
;
CLINE:  RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        PUSH    AF
        TSTCC   COMMA,CLREX    ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        DEC     HL
        LD      B,L
        POP     AF
        DEC     A
        LD      C,A
        SUB     $08
        JR      NC,CLREX
        LD      A,B
        SUB     $08
        JR      NC,CLREX
        PUSH    DE
        LD      HL,LINPAL       ; Base address for Line 1 - 8 Palettes
        LD      D,$00
        LD      E,C
        ADD     HL,DE
        LD      (HL),B
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; KB - FUNCTION TO RETURN NEXT CHARACTER FROM KEYBOARD
;
GETKB:  PUSH    BC
        PUSH    DE
        CALL    CHKIO           ; do Read a character from keyboard
        POP     DE
        POP     BC
        LD      L,A            ;* HL is output register
        LD      H,$00
        RET

; DEVICE VARIABLE TO OUTPUT TO REFERENCED IO PORT
;* OUTPUT &(<expr>)=
;
PUTIO:  RST     RSTPAR          ; GET PORT #  ;* Get value of () or storage adrs
        TSTC    '=',PUTCD2      ; GET EQUALS  ;* Jump if no match
        PUSH    HL              ; SAVE PORT #
        RST     RSTEXP          ; EVALUATE EXPRESSION FOLLOWING
        LD      A,L             ; A=VALUE TO OUTPUT
        POP     HL              ; RESTORE PORT #
        PUSH    BC
        LD      B,H
        LD      C,L
        OUT     (C),A           ; IT    1
        POP     BC
        RST     RSTFIN          ; GO HOME  ;* cr. or ; otherwise, WHAT?

; FUNCTION TO RETURN VALUE OF A GIVEN IO PORT
;* INPUT =&(<expr>)
;
IOFUN:  RST     RSTPAR         ;* Get value of () or storage adrs
        PUSH    BC              ; GET PORT NUMBA
        LD      B,H
        LD      C,L
        IN      A,(C)
        LD      L,A
        LD      H,$00
        POP     BC
        RET

; DEVICE VARIABLE TO PLAY NOTE WITHOUT PRINTING [via MU=]
;
PUTMU:  TSTC    '=',PUTCD2     ;* Equals = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        CALL    PNOTE           ; do Play NOTE tone for key in A
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; DEVICE VARIABLE TO OUTPUT CHARACTER ON VDM [via TV=]
;
PUTCD:  TSTC    '=',PUTCD2     ;* Equals = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression
        LD      A,L
        RST     RSTOUT         ;* Output Char. in A
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

PUTCD2: JP      QWHAT

; ROUTINE TO TRANSFER CONTROL TO ASSEMBLY LANGUAGE SUBROUTINE
;* CALL <expr>
;
DOCALL: LD      HL,BBRET        ; PUSH RETURN ADDR ON STACK
        PUSH    HL
        RST     RSTEXP          ; GET ADDRESS  ;* Evaluate expression
        JP      (HL)            ; AND JUMP TO IT

; :RETURN to close off the tape input port
;
TCLOSE: CALL    INIT0           ; do INITialize interrupts to 0
BBRET:  RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

;* Initialize interrupts
;
INIT0:  IN      A,(SW2)         ; $12 for 300 Baud Interface ??
        AND     $02
        JR      NZ,INIT0        ; Loop on Down ??
        LD      (CHMODE),A      ; Zero
        LD      A,$1E
        LD      (DEVTEM),A     ;* Preset Note Time

        DI
        IM      2
        LD      A,ITAB >> 8    ;* Interrupt Page
        LD      I,A
        LD      A,$08           ; Normal Screen Interrupt only
        OUT     (INMOD),A
        LD      A,ITAB & $FF    ; Set TBIINT as Interrupt
        OUT     (INFBK),A      ;* Interrupt vector
        EI
        RET

; ** TINY BASIC EXECUTION STARTS HERE **
; CLEAR WHOLE KIT AND KABOOBLE
;
;***********************
;*      Cold Start     *
;***********************
;
BEGIN:  XOR     A
        OUT     (MAGIC),A       ; Set up port $0C
        LD      HL,NORMEM
        LD      B,A
    ; [ab added MAKE SURE SHIFTER FLUSHED code here]
BEGIN1: LD      (HL),B
        INC     HL
        LD      A,H
        CP      $50
        JR      NZ,BEGIN1
        LD      SP,SYSRAM

        SYSTEM  INTPC          ;* Start multiple Subr.

        DO      SETOUT
        DB      $80            ;* Display height
        DB      00101100B      ;* Border [$2C or 44] color 0, Left
        DB      $08            ;* Normal interrupts

        DO      EMUSIC         ;* Kill sound

; INITIALIZE DEVICE VARIABLES
        DO      SETB            ; STORE BYTE (SYSTEM ROUTINE)
        DB      OA2             ; $47 for Dick Answorth notes
        DW      MUZMO           ; for Master Oscillator

        DO      FILL            ; FILL BYTES (SYSTEM ROUTINE)
        DW      PALCLR          ; Base address for Color Palettes
        DW      $0020           ; 32 bytes of color
        DB      $07             ; set all to White

        DO      SETB            ; STORE BYTE (SYSTEM ROUTINE)
        DB      $00             ; Black
        DW      PALCLR + 1      ; FOREGROUND COLOR Palette #1

        DO      SETB            ; STORE BYTE (SYSTEM ROUTINE)
        DB      $0C             ; Begin at Scanline #12
        DW      SCNLIN          ; Interrupt LINE number

        DO      MOVE            ; MOVE BYTES (SYSTEM ROUTINE)
        DW      DEVVAR
        DW      $000A          ;* Move 10 bytes from
        DW      INIDEV         ;* $2021 to $4E82

        DO      MOVE            ; MOVE BYTES (SYSTEM ROUTINE)
        DW      ALTFON
        DW      $0007          ;* Move 7 bytes from
        DW      FNTSYS         ;* $0206 to $4E46

        DO      SETW            ; STORE WORD (SYSTEM ROUTINE)
        DW      $0806
        DW      ALTFON + 1     ;* Frame height [still] = 8, Char spacing = 6

        DO      SETW            ; STORE WORD (SYSTEM ROUTINE)
        DW      TXT + 4
        DW      TXTUNF         ;* LD (TXTUNF),$4A04 [actual memory location]

        DO      XINTC          ;* End multiple Subr.

        LD      HL,TXT + 1      ; TeXT + 1 init to $FF (or -1) End of Program marker
        LD      A,$FF
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
RINIT:  CALL    INIT0           ; do INITialize interrupts to 0
INIT:   CALL    CRLF            ; do display a Carriage Return (and Line Feed)
TELL:   LD      DE,CBASIC       ; "COLOR BASIC",cr text
        CALL    PRTSTG          ; do PRinT STrinG to TV

; DIRECT COMMAND - TEXT COLLECTOR
;
; STOP command
;
STOP:
RSTART: LD      SP,STACKP       ; RANSHT precludes MUZCPU and Counter Timers
        LD      HL,XXST1 + 1
        LD      (CURRNT),HL
XXST1:  LD      HL,$0000
        LD      (LOPVAR),HL
        LD      (STKGOS),HL
XXST2:  LD      A,'>'
        CALL    GETLN           ; do GET a LiNe
        PUSH    DE
        LD      DE,BUFFER
        LD      A,(DE)
        CP      '>'
        JR      NZ,XXST3
        INC     DE
XXST3:  CALL    TSTNUM         ;* Get possible line number
        RST     RSTIGN         ;* Get next non-blank from (DE)
        LD      A,H
        OR      L
        POP     BC             ;* BC = end of line
        JR      Z,EXEC0        ;* Direct mode if no line #
        LD      (OLDLN),HL
        DEC     DE             ;* Put binary line number in
        LD      A,H            ;*  front of first significant
        LD      (DE),A         ;*  character of line in input
        DEC     DE             ;*  buffer
        LD      A,L
        LD      (DE),A
        PUSH    BC
        PUSH    DE
        LD      A,C
        SUB     E
        PUSH    AF             ;* A = # bytes in line
        CALL    FNDLN          ;* Find this line in SAVE area
        PUSH    DE             ;* DE = adrs
        JR      NZ,XXST4       ;* Jp if not found; insert
        PUSH    DE             ;* Found, delete it
        CALL    FNDNXT         ;* Find next line
        POP     BC             ;* Start adrs of line to delete
        LD      HL,(TXTUNF)    ;* End of all text
        CALL    MVUP           ;* Move up to delete
        LD      H,B            ;* Save new text end address
        LD      L,C
        LD      (TXTUNF),HL
XXST4:  POP     BC             ;* Adrs of where to insert
        LD      HL,(TXTUNF)    ;* Text end address
        POP     AF             ;* Length of new line
        PUSH    HL             ;* Save text last adrs.
        CP      $03            ;* Length = 3, delete only
        JR      Z,RSTART
        ADD     A,L            ;* Compute new text end
        LD      E,A            ;*   to DE
        LD      A,$00
        ADC     A,H
        LD      D,A
        LD      HL,DFTLMT      ;* Last possible address
        EX      DE,HL
        CALL    COMP            ; do COMPare HL and DE
        JP      NC,QSORRY      ;* SORRY if no room
        LD      (TXTUNF),HL    ;* Save new text end
        POP     DE             ;* Old text end
        CALL    MVDOWN          ; do MoVe a block DOWN
        POP     DE             ;* New line start
        POP     HL             ;*          end
        CALL    MVUP           ;* Move line to SAVE
        JR      XXST2          ;* Get next line

; DIRECT AND EXEC  ;* Direct Execute
;
EXEC0:  RST     RSTIGN          ; GET FIRST     NONBLANK  ;* Get next non-blank from (DE)
        PUSH    DE              ; SAVE POINTER
        CP      $68             ; IS SHE A TOKEN?  ;* Is this a word?
        JR      C,EXEC0A        ; NO
        CP      $77            ;* Yes, sure? [only $75 in bb]
        JR      NC,EXEC0A      ;* No, assume implied LET
; WE FOUND A TOKEN - LOOKUP IN TABLE AND JUMP TO IT
        RLCA
        LD      E,A
        LD      D,$00
        LD      HL,TOKJT - $D0 ;* Jump table [TOKJT - (2 * $68)]
        ADD     HL,DE
        LD      E,(HL)
        INC     HL
        LD      D,(HL)
        EX      DE,HL
        POP     DE
        INC     DE
        JP      (HL)           ;* Go to proper routine

; NOT A TOKEN - A VARIABLE PERHAPS?
EXEC0A: CALL    TSTV            ; TEST FOR VARIABLE  ;* Get adrs. of VRBL
        JR      C,EXEC0B        ; NO - SEARCH   1
        TSTC    '=',EXEC0B     ;* Equals = Char. to check, Jump if no match
        POP     BC
        CALL    SETV1           ; ASSIGNMENT    1
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

EXEC0B: POP     DE
        LD      HL,TAB2 - 1
EXEC:   RST     RSTIGN          ; EXEC  ;* Get next non-blank from (DE)
        PUSH    DE              ; SAVE POINTER
EX1:    LD      A,(DE)          ; ZAPPED LDE
        INC     DE
        INC     HL
        CP      (HL)
        JR      Z,EX1
        LD      A,$7F
        DEC     DE
        CP      (HL)
        JR      C,EX3
EX2:    INC     HL
        CP      (HL)
        JR      NC,EX2
        INC     HL
        POP     DE
        JR      EXEC

EX3:    LD      A,(HL)          ; LOAD HL WITH THE JUMP
        INC     HL              ; ADDRESS FROM TABLE
        LD      L,(HL)
        AND     $7F
        LD      H,A
        POP     AF
        JP      (HL)

; CLEAR COMMAND
;
; Clear Screen routine
CLRSCR: LD      HL,NORMEM
        PUSH    DE
        LD      DE,NORMEM + 1
        LD      (HL),$00
        LD      BC,$09FF
        LDIR
; RESET VDM GOODIES
        SYSSUK  MOVE
        DW      VDMX
        DW      $0006           ; 6 bytes   VDM X, VDM Y, OLDXY
        DW      INIVDM          ; INIDEV Part 2 to $4E88

        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; RUN routine(s)
;
RUN:    LD      DE,TXT
; RUn NeXt One
RUNX1:  LD      HL,$0000       ;* RST30 Jumps here on cr
        CALL    FNDLP          ;* Find next line [starting at Pointer] 
        JP      C,RSTART       ;* Passed end; quit
; RUN The goSub Line
RUNTSL: EX      DE,HL
        LD      (CURRNT),HL    ;* Set CURRNT to line address
        EX      DE,HL
        INC     DE             ;* Bump past line number
        INC     DE
; RUN SaMe Line  ;* RST30 Jps to RUNSML on ;
RUNSML: CALL    WHATSU          ; CHECK FOR INTERRUPT KEY
        JP      EXEC0          ;* Continue Same line execution [close enough for JR]

; GOTO routine
;
GOTO:   RST     RSTEXP         ;* Evaluate expression
        PUSH    DE             ;* Save for error routine
        CALL    FNDLN          ;* Find target line
        JP      NZ,AHOW        ;* No such line
        POP     AF             ;* Clear stack
        JR      RUNTSL

; LIST AND PRINT
;
;* LIST [<expr1>][,<expr2>]
LISTCOM:
        LD      HL,$0000        ; ASSUME AT EOL  ;* Preset to list from beginning
        RST     RSTIGN         ;* Get next non-blank from (DE)
        CALL    ZONATNL         ; do Zero ON AT NewLine or ;
        JR      Z,LIS1         ;* Jp if ; or cr
        CP      ','             ; LEADING COMMA?  ;* Jp if only # lines specified
        JR      Z,LIS1          ; YEP - SKIP FIRST EXPR GET
; NOT AT FIRST - GET FIRST EXPR
        RST     RSTEXP         ;* Evaluate expression
LIS1:   PUSH    HL             ;* Save line # for start
        LD      HL,$FFFF       ;* Set for max number of lines
        TSTCC   COMMA,LIS2     ;* Comma = Char. to check, Jump if no match
        RST     RSTEXP         ;* Evaluate expression  ;* Get number of lines
LIS2:   PUSH    DE
        POP     IY
        EX      (SP),HL
        CALL    FNDLN           ; do FiND HL Line Number in TeXT
LIS3:   JR      C,LSQUIT
        EX      (SP),HL
        LD      A,H
        OR      L
        JR      Z,LSQUIT
        DEC     HL
        EX      (SP),HL
        CALL    PRTLN           ; do PRinT Line Number then Space
        CALL    PRTSTG          ; do PRinT STrinG to TV
        CALL    WHATSU          ; do Check for PAUSE or ABORT keys
        CALL    FNDLP           ; do FiND Linenumber starting at Pointer
        JR      LIS3

LSQUIT: PUSH    IY
        POP     DE
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; PRINT routine
;
PRINT:  LD      C,$08           ; C=# OF SPACES  /* Default number of spaces
        TSTCC   $3B,PRT1        ; IF NULL LIST & ";"  ;* Jump if no match
        CALL    CRLF            ; GIVE CR-LF AND
        JR      RUNSML          ; CONTINUE SAME LINE

PRT1:   TSTCC   CR,PRT5         ; IF NULL LIST (CR)  ;* Jump if no match
        CALL    CRLF            ; GIVE CR-LF AND
        JR      RUNX1           ; CONTINUE SAME LINE

PRT2:   TSTC    '#',PRT3        ; ELSE IS IT FORMAT?  ;* Jump if no match
        RST     RSTEXP          ; YES, EVALUATE EXPR.
        LD      A,$C0          ;* Limit to 6 bits
        AND     L
        OR      H
        JP      NZ,QHOW
        LD      C,L             ; AND SAVE IT IN C
        JR      PRT4            ; LOOK FOR MORE TO PRINT

PRT3:   CALL    QTSTG           ; OR IS IT A STRING?
        JR      PRT8            ; IF NOT, MUST BE EXPR.

PRT4:   TSTCC   COMMA,PRT7      ; IF COMMA, GO FIND NEXT  ;* Jump if no match
PRT5:   TSTCC   COMMA,PRT6     ;* Comma = Char. to check, Jump if no match
        LD      A,$20
        RST     RSTOUT          ; Output SPACE in A
        JR      PRT5

PRT6:   CALL    FIN             ; IN THE LIST.
        JR      PRT2            ; LIST CONTINUES

PRT7:   CALL    CRLF            ; LIST ENDS
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

PRT8:   RST     RSTEXP          ; EVALUATE THE EXPR
        PUSH    BC
        CALL    PRTNUM          ; PRINT THE VALUE
        POP     BC
        JR      PRT4            ; Next value [not another PRINT THE VALUE]

; ***************************************************************
; *
; * *** GOSUB *** & *** RETURN ***
; *
; * 'GOSUB EXPR;' OR 'GOSUB EXPR(CR)' IS LIKE THE 'GOTO' COMMAND,
; * EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER ETC. ARE SAVED
; * SO THAT EXECUTION CAN BE CONTINUED AFTER THE SUBROUTINE 'RETURN'.
; * IN ORDER THAT 'GOSUB' CAN BE NESTED (AND EVEN RECURSIVE), THE SAVE
; * AREA MUST BE STACKED.  THE STACK POINTER IS SAVED IN 'STKGOS'.  THE
; * OLD 'STKGOS' IS SAVED IN THE STACK.  IF WE ARE IN THE MAIN ROUTINE,
; * 'STKGOS' IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF CODE).
; * BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
; *
; * 'RETURN(CR)' UNDOES EVERYTHING THAT 'GOSUB' DID, AND THUS RETURN THE
; * EXECUTION TO THE COMMAND AFTER THE MOST RECENT 'GOSUB'.  IF 'STKDOS'
; * IS ZERO, IT INDICATES THAT WE NEVER HAD A 'GOSUB' AND IS THUS AN
; * ERROR
;
GOSUB:  CALL    PUSHA           ; SAVE THE CURRENT "FOR"  ;* Save current "FOR" params
        RST     RSTEXP          ; PARAMETERS  ;* Evaluate expression
        PUSH    DE              ; AND TEXT POINTER  ;* Save text pointer
        CALL    FNDLN           ; FIND THE TARGET LINE  ;* Find target line
        JP      NZ,AHOW         ; NOT THERE.  SAY "HOW?"  ;* Not present; 'HOW?'
        LD      HL,(CURRNT)     ; SAVE OLD  ;* Save everything
        PUSH    HL              ; 'CURRENT' OLD 'STKGOS'
        LD      HL,(STKGOS)
        PUSH    HL
        LD      HL,$0000        ; AND LOAD NEW ONES
        LD      (LOPVAR),HL    ;* And load it up
        ADD     HL,SP
        LD      (STKGOS),HL
        JP      RUNTSL          ; THEN RUN THAT LINE

RETURN: LD      HL,(STKGOS)     ; OLD STACK POINTER  ;* Old stack pointer
        LD      A,H             ; 0 MEANS NOT EXIST
        OR      L
        JP      Z,QWHAT         ; SO, WE SAY: "WHAT?"  ;* RETURN with no GOSUB
        LD      SP,HL           ; ELSE, RESTORE IT  ;* Restore old SP
        POP     HL
        LD      (STKGOS),HL     ; AND THE OLD 'STKGOS'  ;* And old STKGOS
        POP     HL
        LD      (CURRNT),HL     ; AND THE OLD 'CURRNT'  ;* And old CURRNT
        POP     DE             ;* Get old text pointer
        CALL    POPA           ;* Restore old "FOR" params
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; *******************************************
; *
; * *** FOR *** & NEXT ***
; *
; * 'FOR' HAS TWO FORMS: 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND
; * 'FOR VAR=EXP1 TO EXP2'.  THE SECOND FORM MEANS THE SAME THING
; * AS THE FIRST FORM WITH EXP3=1, (I.E. WITH A STEP OF +1)  TBI
; * WILL FIND THE VARIABLE VAR. AND SET ITS VALUE TO THE CURRENT
; * VALUE OF EXP1.  IT ALSO EVALUATES EXP2 AND EXP3 AND SAVES ALL
; * THESE TOGETHER WITH THE TEXT POINTER ETC. IN THE 'FOR' SAVE AREA
; * WHICH CONSISTS OF 'LOPVAR', 'LOPINC', 'LOPLMT', 'LOPLN', AND 'LOPPT'.
; * IF THERE IS ALREADY SOMETHING IN THE SAVE AREA (INDICATED BY A
; * NON-ZERO 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
; * BEFORE THE NEW ONE OVERWRITES IT.  TBI WILL THEN DIG IN THE STACK
; * AND FIND OUT IF THIS SAME VARIABLE WAS USED IN ANOTHER CURRENTLY
; * ACTIVE 'FOR' LOOP.  IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS
; * DEACTIVATED.  (PURGED FROM THE STACK..)
; *
; * 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILY PHYSICAL) END OF
; * THE 'FOR' LOOP.  THE CONTROL VARIABLE VAR. IS CHECKED WITH THE
; * 'LOPVAR'.  IF THEY ARE NOT THE SAME, TBI DIGS IN THE STACK TO FIND
; * THE RIGHT ONE AND PURGES ALL THOSE THAT DID NOT MATCH.  EITHER WAY,
; * TBI THEN ADDS THE 'STEP' TO THAT VARIABLE AND CHECKS THE RESULT WITH
; * THE LIMIT.  IF IT IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE
; * COMMAND FOLLOWING THE 'FOR'.  IF OUTSIDE THE LIMIT, THE SAVE AREA IS
; * PURGED AND EXECUTION CONTINUES.
;
FOR:    CALL    PUSHA           ; SAVE THE OLD SAVE AREA  ;* Save old "FOR" params
        CALL    SETVAL          ; SET THE CONTROL VAR.  ;* Set control VRBL
        DEC     HL              ; HL IS ITS ADDRESS
        LD      (LOPVAR),HL     ; SAVE THAT
        TSTCC   $79,FR1         ; TO? - LOOK FOR WORD "TO"  ;* "TO" (don't need one)
        RST     RSTEXP          ; EVALUATE THE LIMIT
FR1:    LD      (LOPLMT),HL     ; SAVE THAT  ;* Save limit
        LD      HL,$0001       ;* Preset step of 1
        TSTCC   $77,FR2         ; STEP?  ;* "STEP" (don't need one), Jump if no match
        RST     RSTEXP         ;* Evaluate expression
FR2:    LD      (LOPINC),HL     ; SAVE THAT TOO  ;* Save increment
        LD      HL,(CURRNT)     ; SAVE CURRENT LINE #
        LD      (LOPLN),HL      ; AND TEXT POINTER  ;* Save current line number
        EX      DE,HL
        LD      (LOPPT),HL     ;* And current text pointer
        LD      BC,$000A        ; DIG INTO STACK TO  ;* Dig into stack to find
        LD      HL,(LOPVAR)     ; FIND 'LOPVAR'  ;*  LOPVAR from last
        EX      DE,HL
        LD      H,B
        LD      L,B             ; HL=0 NOW  ;* HL = 0
        ADD     HL,SP           ; HERE IS THE STACK
        JR      FR4

FR3:    ADD     HL,BC           ; EACH LEVEL IS 10 DEEP  ;* Each level is 10 deeper
FR4:    LD      A,(HL)          ; GET THAT OLD 'LOPVAR'  ;* Get old LOPVAR
        INC     HL
        OR      (HL)
        JR      Z,FR5           ; 0 SAYS NO MORE IN IT  ;* Jp if no more
        LD      A,(HL)
        DEC     HL
        CP      D               ; SAME AS THIS ONE?  ;* Same as this one?
        JR      NZ,FR3
        LD      A,(HL)          ; THE OTHER HALF?  ;* Other half also?
        XOR     E
        JR      NZ,FR3
        EX      DE,HL           ; YES, FOUND ONE  ;* Yes, found one
        LD      H,A
        LD      L,A
        ADD     HL,SP           ; TRY TO MOVE SP  ;* Try to move SP
        LD      B,H
        LD      C,L
        LD      HL,$000A
        ADD     HL,DE
        CALL    MVDOWN          ; AND PURGE 10 WORDS  ;* Purge 10 words
        LD      SP,HL           ; IN THE STACK  ;* In the stack
FR5:    LD      HL,(LOPPT)      ; JOB DONE, RESTORE DE  ;* Job done
        EX      DE,HL
        RST     RSTFIN          ; AND CONTINUE  ;* cr. or ; otherwise, WHAT?

NEXT:   CALL    TSTV            ; GET ADDRESS OF VAR.  ;* Get adrs. of VRBL
        JP      C,QWHAT         ; NO VARIABLE, "WHAT?"  ;* None, 'WHAT?'
        LD      (VARNXT),HL     ; YES, SAVE IT  ;* Save its address
NXT1:   PUSH    DE              ; SAVE TEXT POINTER  ;* Save text pointer
        EX      DE,HL
        LD      HL,(LOPVAR)     ; GET VAR. IN 'FOR'  ;* Get VRBL in FOR
        LD      A,H
        OR      L               ; 0 SAYS NEVER HAD ONE
        JP      Z,AWHAT         ; SO WE ASK: "WHAT?"  ;* Never had one
        CALL    COMP            ; ELSE WE CHECK THEM  ;* Check them for match
        JR      Z,NXT2          ; OK, THEY AGREE  ;* Jp if agree
        POP     DE              ; NO, LET'S SEE  ;* No agree, Purge current
        CALL    POPA            ; PURGE CURRENT LOOP  ;* loop and pop one level
        LD      HL,(VARNXT)     ; AND POP ONE LEVEL
        JR      NXT1            ; GO CHECK AGAIN  ;* Try again

NXT2:   EX      DE,HL           ; COME HERE WHEN AGREED  ;* ;Get value of VRBL to DE
        LD      A,(DE)          ; DE=VALUE OF VAR.
        LD      L,A
        INC     DE
        LD      A,(DE)
        LD      H,A
        EX      DE,HL
        LD      HL,(LOPINC)    ;* Get increment
        PUSH    HL
        LD      A,H
        XOR     D               ; S=SIGN OF DIFFER
        LD      A,D             ; A=SIGN OF DE
        ADD     HL,DE           ; ADD ONE STEP  ;* Add one step
        JP      M,NXT3          ; CANNOT OVERFLOW
        XOR     H               ; MAY OVERFLOW
        JP      M,NXT5          ; AND IT DID
NXT3:   EX      DE,HL
        LD      HL,(LOPVAR)     ; PUT IT BACK
        LD      A,E
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
        INC     HL              ; HL=LIMIT
        LD      A,D
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
        LD      HL,(LOPLMT)     ; HL=LIMIT
        POP     AF              ; OLD HL
        OR      A               ; EXAMINE SIGN BIT
        JP      P,NXT4          ; IF POS SKIP EX     DE,HL  ;* Step > 0
        EX      DE,HL          ;* Step < 0
NXT4:   CALL    CKHLDE          ; COMPARE WITH LIMIT  ;* Compare with limit
        POP     DE              ; RESTORE TEST POINTER  ;* Restore text pointer
        JR      C,NXT6          ; OUTSIDE LIMIT  ;* Outside limit
        LD      HL,(LOPLN)      ; WITHIN LIMIT, GO  ;* Within limit
        LD      (CURRNT),HL     ; BACK TO THE SAVED  ;* Put LOPLN in CURRNT
        LD      HL,(LOPPT)      ; 'CURRNT' AND TEXT  ;*  and LOPPT
        EX      DE,HL           ; POINTER
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; RESTO LINKS IN HERE
NXT5:   POP     HL              ; OVERFLOW , PURGE
        POP     DE              ; GARBAGE IN STACK
NXT6:   CALL    POPA            ; PURGE THIS LOOP
        RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

; IF AND REM routines
;
REM:    LD      HL,$0000       ;* Make it false
        JR      IFREM

;* . Comment line
IFF:    RST     RSTEXP         ;* Evaluate expression
IFREM:  LD      A,H
        OR      L
        JP      NZ,RUNSML      ;* Jp if true
        CALL    FND2           ;* Otherwise skip rest of line
        JP      NC,RUNTSL      ;* And run next one
        JP      RSTART

; *********************************************************
; *
; * *** IF *** INPUT *** & LET (& DEFLT) ****
; *
; * 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE COMMANDS
; * (INCLUDING OTHER 'IF'S) SEPARATED BY SEMI-COLONS.  NOTE THAT THE
; * WORD 'THEN' IS NOT USED.  TBI EVALUATES THE EXPR. IF IT IS NON-ZERO,
; * EXECUTION CONTINUES.  IF THE EXPR. IS ZERO, THE COMMANDS THAT
; * FOLLOW ARE IGNORED AND EXECUTION CONTINUES AT THE NEXT LINE.
; *
; * 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED BY A
; * LIST OF ITEMS.  IF THE ITEM IS A STRING IN A SINGLE OR DOUBLE QUOTES,
; * OR IS AN UP-ARROW, IT HAS THE SAME EFFECT AS IN 'PRINT'.  IF AN ITEM
; * IS A VARIABLE, THIS VARIABLE NAME IS PRINTED OUT FOLLOWED BY A
; * COLON.  THEN TBI WAITS FOR AN EXPR. TO BE TYPED IN.  THE VARIABLE IS
; * THEN SET TO THE VALUE OF THIS EXPR.  IF THE VARIABLE IS PROCEDED BY
; * A STRING (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
; * PRINTED FOLLOWED BY A COLON.  TBI THEN WAITS FOR INPUT EXPR.   AND
; * SETS THE VARIABLE TO THE VALUE OF THE EXPR.
; *
; * IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?", "HOW?", OR
; * "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.  THE EXECUTION
; * WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.  THIS IS HANDLED IN
; * 'INPERR'.
;
INPERR: LD      HL,(STKINP)     ; *** INPERR ***
        LD      SP,HL           ; RESTORE OLD SP
        POP     HL              ; AND OLD 'CURRNT'
        LD      (CURRNT),HL
        POP     DE              ; AND OLD TEXT POINTER
        POP     DE              ; REDO INPUT
INPUT:  PUSH    DE              ; SAVE IN CASE OF ERROR
        CALL    QTSTG           ; IS NEXT ITEM A STRING?
        JR      INP4            ; NO

INP0:   CALL    TSTV            ; YES, BUT FOLLOWED BY A  ;* Get adrs. of VRBL
        JR      C,INP2          ; M6IVARIABLE? NO.
INP1:   CALL    INP6
        LD      DE,BUFFER       ; POINTS TO BUFFER
        RST     RSTEXP          ; EVALUATE INPUT
        POP     DE              ; OK, GET OLD HL
        EX      DE,HL
        LD      A,E            ;* Save value in VRBL
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
        INC     HL
        LD      A,D
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
        POP     HL              ; GET OLD 'CURRNT'
        LD      (CURRNT),HL
        POP     DE              ; AND OLD TEXT POINTER
INP2:   POP     AF              ; PURGE JUNK IN STACK
        TSTCC   COMMA,INP3
        JR      INPUT           ; YES, MORE ITEMS.

INP3:   RST     RSTFIN         ;* cr. or ; otherwise, WHAT?

INP4:   PUSH    DE              ; SAVE FOR 'PRTSTG'
        CALL    TSTV            ; MUST BE VARIABLE NOT  ;* Get adrs. of VRBL
        JR      NC,INP5        ;* OK [became JP  C,QWHAT in ab]
        JP      QWHAT           ; "WHAT?" IT IS NOT?

INP5:   LD      B,E
        POP     DE
        CALL    PRTCHS          ; PRINT THOSE AS PROMPT
        JR      INP1            ; YES, INPUT VARIABLE

INP6:   POP     BC              ; RETURN ADDRESS
        PUSH    DE              ; SAVE TEXT POINTER  ;* Save in case of error
        EX      DE,HL
        LD      HL,(CURRNT)     ; ALSO SAVE 'CURRNT'
        PUSH    HL
        LD      HL,INPUT        ; A NEGATIVE NUMBER
        LD      (CURRNT),HL     ; AS A FLAG
        LD      HL,$0000        ; SAVE SP TOO
        ADD     HL,SP
        LD      (STKINP),HL
        PUSH    DE              ; OLD HL
        PUSH    BC
        LD      A,' '          ;* Space after VRBL
        JP      GETLN           ; AND GET A LINE

ENDCHK: LD      A,(DE)         ;* End of list 1 [or DEFLT: ??]
        CP      CR             ;* Empty link is OK
        JR      Z,INP3
        JP      QWHAT          ;* Else 'WHAT?'

; *********************************************
; *
; * *** EXPR ***
; *
; * 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
; * <EXPR>::=<EXPR1>
; *           <EXPR1><REL.OP><EXPR1>
; * WHERE <REL.OP> IS ONE OF THE OPERATORS IN TAB6 AND THE RESULT
; * OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
; *
; * <EXPR1>::=(+ OR -)<EXPR2>(+ OR -<EXPR2>)(...)
; * WHERE () ARE OPTIONAL AND (...) ARE OPTIONAL REPEATS.
; *
; * <EXPR2>::=<<EXPR3>(<* OR /><EXPR3>)(...)
; *
; * <EXPR3>::=<VARIABLE>
; *            <FUNCTION>
; *            (<EXPR>)
; *
; * <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
; * AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
; * <EXPR3> CAN BE AN <EXPR> IN PARENTHESES.
;
EXPR:   CALL    EXPR1           ; *** EXPR ***
        PUSH    HL              ; SAVE <EXPR1> VALUE
        LD      HL,TAB6 - 1     ; LOOKUP REL.OP.
        JP      EXEC            ; GO DO IT.

XPR1:   CALL    XPR8            ; REL.OP. ">="
        RET     C               ; NO, RETURN HL=0
        LD      L,A             ; YES, RETURN HL=1
        RET

XPR2:   CALL    XPR8            ; REL.OP. "#"
        RET     Z               ; FALSE, RETURN HL=0
        LD      L,A             ; TRUE, RETURN HL=1
        RET

XPR3:   CALL    XPR8            ; REL.OP. ">"
        RET     Z               ; FALSE
        RET     C
        LD      L,A             ; TRUE, RETURN HL=1
        RET

XPR4:   CALL    XPR8            ; REL.OP "<="
        LD      L,A             ; SET HL=1
        RET     Z               ; REL. TRUE, RETURN
        RET     C
        LD      L,H             ; ELSE SET HL=0
        RET

XPR5:   CALL    XPR8            ; REL.OP. "="
        RET     NZ              ; FALSE, RETURN HL=0
        LD      L,A             ; ELSE SET HL=1
        RET

XPR6:   CALL    XPR8            ; REL.OP. "<"
        RET     NC              ; FALSE, RETURN HL=0
        LD      L,A             ; ELSE SET HL=1
        RET

XPR7:   POP     HL              ; NOT REL.OP.  ;* - end of list 3
        RET                     ; RETURN HL=<EXPR1>

XPR8:   LD      A,C             ; SUBROUTINE FOR ALL
        POP     HL              ; REL.OP.'S
        POP     BC
        PUSH    HL              ; REVERSE TOP OF STACK
        PUSH    BC
        LD      C,A
        CALL    EXPR1           ; SET 2ND <EXPR1>
        EX      DE,HL           ; VALUE IN DE NOW
        EX      (SP),HL         ; 1ST <EXPR1> IN HL
        CALL    CKHLDE          ; COMPARE 1ST WITH 2ND
        POP     DE              ; RESTORE TEXT POINTER
        LD      HL,$0000        ; SET HL=0, A=1
        LD      A,$01
        RET

EXPR1:  TSTC    '-',XP11        ; NEGATIVE SIGN?
        LD      HL,$0000        ; YES, FAKE "0-"
        JR      XP16            ; TREAT LIKE SUBTRACT  ;* Fake "0-x"

XP11:   TSTC    '+',XP12        ; POSITIVE SIGN?  IGNORE  ;* Ignore leading +
XP12:   CALL    EXPR2           ; 1ST <EXPR2>
XP13:   TSTC    '+',XP15        ; ADD?
        PUSH    HL              ; YES, SAVE VALUE
        CALL    EXPR2           ; GET 2ND <EXPR2>
XP14:   EX      DE,HL           ; 2ND IN DE
        EX      (SP),HL         ; 1ST IN HL
        LD      A,H             ; COMPARE SIGN
        XOR     D
        LD      A,D
        ADD     HL,DE
        POP     DE              ; RESTORE TEST POINTER
        JP      M,XP13          ; 1ST 2ND SIGN DIFFER  ;* Jp if signs different
        XOR     H               ; 1ST 2ND SIGN EQUAL  ;* Signs alike
        JP      P,XP13          ; SO IS RESULT
        JP      QHOW            ; ELSE WE HAVE OVERFLOWN

XP15:   TSTC    '-',XPR9        ; SUBTRACT?
XP16:   PUSH    HL              ; YES, SAVE 1ST <EXPR2>
        CALL    EXPR2           ; GET 2ND <EXPR2>
        CALL    CHGSGN          ; NEGATE
        JR      XP14            ; AND ADD THEM

EXPR2:  CALL    EXPR3           ; GET 1ST <EXPR3>
XP21:   TSTCC   $62,XP24        ; MULTIPLY?
        PUSH    HL              ; YES, SAVE 1ST
        CALL    EXPR3           ; AND GET 2ND <EXPR3>
        LD      B,$00           ; CLEAR B FOR SIGN
        CALL    CHKSGN          ; CHECK SIGN
        EX      (SP),HL         ; 1ST IN HL
        CALL    CHKSGN          ; CHECK SIGN OF 1ST
        EX      DE,HL          ;* 2nd in DE
        EX      (SP),HL        ;* Get back 1st
        LD      A,H             ; IS HL > 255?
        OR      A
        JR      Z,XP22          ; NO  ;* Jp if HL <255
        LD      A,D             ; YES, HOW ABOUT DE
        OR      D
        EX      DE,HL           ; PUT SMALLER IN DE
        JP      NZ,AHOW         ; ALSO >, WILL OVERFLOW ;* Jp if DE >255 (will overflow)
XP22:   LD      A,L             ; THIS IS DUMB
        LD      HL,$0000        ; CLEAR RESULT
        OR      A               ; ADD AND COUNT
        JR      Z,XP25         ;* Done
XP23:   ADD     HL,DE
        JP      C,AHOW          ; OVERFLOW
        DEC     A
        JR      NZ,XP23        ;* Continue multiply
        JR      XP25            ; FINISHED

XP24:   TSTCC   $63,XPR9        ; DIVIDE?  ;* Jump if no match
        PUSH    HL              ; YES, SAVE 1ST <EXPR3>
        CALL    EXPR3           ; AND GET 2ND ONE
        LD      B,$00           ; CLEAR B FOR SIGN
        CALL    CHKSGN          ; CHECK SIGN OF 2ND
        EX      (SP),HL         ; GET 1ST IN HL
        CALL    CHKSGN          ; CHECK SIGN OF 1ST
        EX      DE,HL
        EX      (SP),HL
        EX      DE,HL
        LD      A,D             ; DIVIDE BY 0?
        OR      E
        JP      Z,AHOW          ; SAY "HOW?"
        PUSH    BC              ; ELSE, SAVE SIGN
        CALL    DIVIDE          ; USE SUBROUTINE
        POP     DE              ; SIGN STUFF TO DE
        PUSH    BC              ; SAVE DIVIDE RESULT
        BIT     7,D             ; WAS SIGN SET?
        CALL    NZ,CHGSGN       ; YEP - CHANGE
        LD      (REMAIN),HL     ; STUFF IT
        POP     HL              ; RESULT IN HL
        LD      B,D             ; COPY OVER SIGN STUFF
        LD      C,E
XP25:   POP     DE              ; GET TEXT POINTER BACK
        LD      A,H             ; HL MUST BE +
        OR      A
        JP      M,QHOW          ; ELSE IT IS OVERFLOW
        LD      A,B
        OR      A
        CALL    M,CHGSGN        ; CHANGE SIGN IF NEEDED
        JR      XP21            ; LOOK FOR MORE TERMS

EXPR3:  LD      HL,TAB3 - 1     ; FIND FUNCTION IN TAB3
        JP      EXEC            ; AND GO DO IT

NOTF:   CALL    TSTV            ; NO, NOT A FUNCTION  ;* End of list 2
        JR      C,XP32          ; NOR A VARIABLE  ;* Is it a variable? No
        EX      DE,HL          ;* Yes, a variable
        LD      A,(DE)
        PUSH    AF
        INC     DE
        LD      A,(DE)
        EX      DE,HL
        LD      H,A            ;* Get VRBL value to HL
        POP     AF
        LD      L,A
        RET

XP32:   CALL    TSTNUM          ; OR IS IT A NUMBER?
        LD      A,B             ; # OF DIGIT
        OR      A
        RET     NZ              ; OK
; SINGLE CHAR STRING CONSTANT?
        TSTC    '"',XPR9        ; HAVE WE GOT QUOTES?  ;* Get one byte ASCII input
        LD      A,(DE)          ; NAILED RSTLDE [instead of using RST RSTLDE ??]
        LD      L,A             ; FAILED TSTNUM SET H TO ZERO
        INC     DE
        TSTC    '"',XPR9        ; ERROR IF NO TRAILING
        RET

; *****
; *
;
PARN:   TSTC    '(',XPRO        ; NO DIGIT, MUST BE
        RST     RSTEXP          ; "(EXPR)"  ;* Evaluate expression
        TSTC    ')',XPRO
XPR9:   RET

XPRO:   JP      QWHAT           ; ELSE SAY: "WHAT?"

; *** RND(EXOR) ***
;
RND:    RST     RSTPAR          ; *** RND(EXOR) ***  ;* Get value of () or storage adrs
        LD      A,H             ; EXPR MUST BE +
        OR      A
        JP      M,QHOW         ;* Bad if -
        OR      L
        JP      Z,QHOW         ;* or if 0
        PUSH    DE              ; SAVE BOTH
        EX      DE,HL           ; DE = RANGE
        XOR     A
        SYSTEM  RANGED          ; Get Random Number

        LD      L,A
        XOR     A
        SYSTEM  RANGED          ; Get Random Number

        LD      H,A
; HL = RANDOM #
        PUSH    BC
        CALL    DIVIDE          ; RND(N)=MOD(M,N)+1
        POP     BC
        POP     DE
        INC     HL
        RET

ABS:    RST     RSTPAR          ; *** ABS(EXPR) ***  ;* Get value of () or storage adrs
        DEC     DE
        CALL    CHKSGN          ; CHECK SIGN
        INC     DE
        RET

SIZE:   LD      HL,(TXTUNF)     ; *** SIZE ***
        PUSH    DE              ; GET THE NUMBER OF
        EX      DE,HL           ; FREE BYTES BETWEEN 'TXTUNF'
        LD      HL,DFTLMT       ; AND 'TXTLMT'
        AND     A
        SBC     HL,DE
        POP     DE
        RET

; FUNCTION TO SENSE DIAL VALUE
;
GETPOT: LD      A,$1B
        CALL    CHKRNG          ; GET DATA
        CPL
        SUB     $80
        LD      L,A
; FALL INTO...
; SIGN EXTEND SUBROUTINE
SGNEXT: LD      H,$00
        LD      A,L
        AND     A
        RET     P
        DEC     H
        RET

; FUNCTION TO SENSE STATE OF TRIGGER
;
GETTRG: CALL    CHKRN1          ; do CHecK RaNge is 1-4
        AND     $10
        RET     Z
        INC     L
        RET

; FUNCTIONS TO RETURN JOYSTICK VALUE
; THESE FUNCTIONS RETURN EITHER +1, 0, OR -1, DEPENDING
; ON JOYSTICK STATE
;
GETJX:  CALL    CHKRN1          ; PARM IN RANGE?
        RRCA
        RRCA
        RRCA
        JR      C,GETJY3
        RRCA
        JR      C,GETJY1
        RET

; ENTRY FOR Y JOYSTICK VALUE
GETJY:  CALL    CHKRN1          ; do CHecK RaNge is 1-4
        RRCA
        JR      NC,GETJY2
GETJY1: INC     HL
        RET

GETJY2: RRCA
        RET     NC
GETJY3: DEC     HL
        RET

; SUBROUTINE TO GET PARAMETER BETWEEN 1 AND 4
;
CHKRN1: LD      A,$0F
CHKRNG: PUSH    BC
        PUSH    AF
        RST     RSTPAR         ;* Get value of () or storage adrs
        POP     AF
        ADD     A,L
        LD      C,A
        IN      A,(C)
        POP     BC
        LD      HL,$0000
        RET

; **********************************************
; * *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
; *
; * 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
; *
; * 'SUBDE' SUBTRACTS DE FROM HL
; *
; * 'CHKSGN' CHECKS SIGN OF HL.  IF +, NO CHANGE.  IF -, CHANGE SIGN
; * AND FLIP SIGN OF B.
; *
; * 'CHKSGN' CHANGES SIGN OF HL AND B UNCONDITIONALLY.
; *
; * 'CKHLDE' CHECKS SIGN OF HL AND DE.  IF DIFFERENT, HL AND DE ARE
; * INTERCHANGED.  IF SAME SIGN, NOT INTERCHANGED.  EITHER CASE, HL DE
; * ARE THEN COMPARED TO SET THE FLAGS.
;
DIVIDE: PUSH    HL              ; *** DIVIDE ***
        LD      L,H             ; DIVIDE H BY DE
        LD      H,$00
        CALL    DV1
        LD      B,C             ; SAVE RESULT IN B
        LD      A,L             ; (REMAINDER + L)/DE
        POP     HL
        LD      H,A
DV1:    LD      C,$FF           ; RESULT IN C [initialize to -1]
DV2:    INC     C               ; DUMB ROUTINE
        AND     A
        SBC     HL,DE
        JR      NC,DV2
        ADD     HL,DE
        RET

CHKSGN: LD      A,H             ; *** CHKSGN ***  ;* Check sign of HL
        OR      A               ; CHECK SIGN OF HL
        RET     P               ; IF -, CHANGE SIGN  ;* Leave if +

CHGSGN: LD      A,H             ; *** CHGSGN ***  ;* Change sign of HL
        OR      L
        RET     Z              ;* +0 stays the same
        LD      A,H            ;* Change sign
        PUSH    AF
        CPL                     ; CHANGE SIGN OF HL
        LD      H,A
        LD      A,L
        CPL
        LD      L,A
        INC     HL
        POP     AF
        XOR     H
        JP      P,QHOW
        LD      A,B             ; AND ALSO FLIP B  ;* Also flip sign of B
        XOR     $80
        LD      B,A
        RET

CKHLDE: LD      A,H             ; *** CKHLDE ***
        XOR     D               ; SAME SIGN?
        JP      P,CK1           ; YES, COMPARE  ;* Jp if same sign
        EX      DE,HL           ; NO, XCH AND COMPARE  ;* Exchange
CK1:    CALL    COMP           ;* Compare
        RET

;* COMPare HL and DE
;* Z if HL = DE
;* C if HL < DE
COMP:   LD      A,H             ; *** COMP ***
        CP      D               ; COMPARE HL WITH DE
        RET     NZ              ; RETURN CORRECT C AND
        LD      A,L             ; ZFLAGS
        CP      E               ; BUT OLD A IS LOST
        RET

; ***************************************************
; *
; * *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS)***
; *
; * 'SETVAL' EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND THEN AN
; * EXPR.  IT EVALUATES THE EXPR. AND SETS THE VARIABLE TO THAT VALUE.
; *
; * 'FIN' CHECKS THE END OF A COMMAND.  IF IT ENDED WITH ";", EXECUTION
; * CONTINUES.  IF IT ENDED WITH A CR, IT FINDS THE NEXT LINE AND
; * CONTINUES FROM THERE.
; *
; * 'ENDCHK' CHECKS IF A COMMAND IS ENDED WITH CR.  THIS IS REQUIRED IN
; * CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.) [up with 'INPUT' ??]
; *
; * 'ERROR' PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR). IT THEN
; * PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?" INSERTED AT WHERE THE
; * OLD TEXT POINTER (SHOULD BE ON TOP OF THE STACK) POINTS TO.
; * EXECUTION OF TB IS STOPPED AND TBI IS RESTARTED.  HOWEVER, IF
; * 'CURRNT'=> ZERO (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND
; * IS NOT PRINTED. AND IF 'CURRNT'=>NEGATIVE # (INDICATING 'INPUT'
; * COMMAND, THE INPUT LINE IS NOT PRINTED AND EXECUTION IS NOT
; * TERMINATED BUT CONTINUED AT 'INPERR'.
; *
; * RELATED TO 'ERROR' ARE THE FOLLOWING: 'QWHAT' SAVES TEXT POINTED IN
; * STACK AND GETS MESSAGE "WHAT?".  'AWHAT' JUST GETS MESSAGE "WHAT?"
; * AND JUMPS TO 'ERROR'.  'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
; * 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
;
SETVAL: CALL    TSTVFF          ; *** SETVAL ***  ;* Get adrs. of VRBL
        TSTC    '=',QWHAT       ; "WHAT?" NO VARIABLE  ;* Jump if no match
SETV1:  PUSH    HL              ; SAVE ADDRESS OF VAR.
        RST     RSTEXP          ; EVALUATE EXPR.
        LD      B,H
        LD      C,L            ;* Value now in BC
        POP     HL             ;* Get address
        PUSH    AF
        LD      A,C
        CALL    STHL           ;* Place into VRBL [interlaced into TeXT if necessary]
        INC     HL
        LD      A,B
        CALL    STHL            ; STore A by HL [interlaced into TeXT if necessary]
        POP     AF
        RET

FINISH: CALL    FIN             ; CHECK END OF COMMAND  ;* RST30 after POP AF
        JR      QWHAT           ; PRINT "WHAT?" IF WRONG

FIN:    TSTCC   $3B,FIN1        ; *** FIN ***  ;* Semicolon, Jump if no match
        POP     AF              ; ";", PURGE RET ADDR.
        JP      RUNSML          ; CONTINUE SAME LINE

FIN1:   TSTCC   CR,FNDX         ; NOT ";", IS IT CR?  ;* $0D, Jump if no match
        POP     AF              ; PURGE RETURN ADDRESS
        JP      RUNX1

IGNBLK: LD      A,(DE)          ; *** IGNBLK ***  ;* RST20 [not RST#0]
        CP      ' '             ; IGNORE BLANKS $20
        RET     NZ              ; IN TEXT (WHERE DE->)
        INC     DE              ; AND RETURN THE FIRST
        JR      IGNBLK          ; NON-BLANK CHAR. IN A

QWHAT:  PUSH    DE              ; *** QWHAT ***
AWHAT:  LD      DE,WHAT         ; *** AWHAT ***
ERROR:  CALL    CRLF            ; *** ERROR ***
        CALL    PRTSTG          ; PRINT ERROR MESSAGE
        LD      HL,(CURRNT)     ; GET CURRENT LINE #  ;* Current line pointer
        PUSH    HL             ;* Save it
        EX      DE,HL           ; CHECK THE VALUE
        LD      A,(DE)         ;* Get character in text
        LD      H,A
        INC     DE
        LD      A,(DE)
        OR      H
        EX      DE,HL
        POP     DE             ;* Set DE to line #
        JP      Z,TELL          ; IF ZERO, JUST RESTART  ;* If 0, just restart
        EX      DE,HL           ; IF NEGATIVE  ;* Get first digit
        LD      A,(DE)
        EX      DE,HL
        OR      A
        JP      M,INPERR        ; REDO INPUT  ;* If negative, redo input
        CALL    PRTLN           ; ELSE PRINT THE LINE Number then Space
        POP     BC              ; HL=ERROR ADDR
        LD      B,C
        CALL    PRTCHS
        LD      A,'?'
        RST     RSTOUT          ; Output $3F Question Mark in A
        CALL    PRTSTG          ; LINE
        JP      TELL            ; THEN RESTART

QSORRY: PUSH    DE              ; *** QSORRY ***
ASORRY: LD      DE,SORRY        ; *** ASORRY ***
        JR      ERROR

; ******************************************
; *
; * *** FNDLN (& FRIENDS) ***
; *
; * 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE TEXT SAVE
; * AREA.  DE IS USED AS THE TEXT POINTER.  IF THE LINE IS FOUND, DE
; * WILL POINT TO THE BEGINNING OF THAT LINE (I.E., THE LOW BYTE OF THE
; * LINE #), AND FLAGS ARE NC & Z.  IF THAT LINE IS NOT THERE AND A LINE
; * WITH A HIGHER LINE # IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC &
; * NZ.  IF WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
; * LINE, FLAGS ARE C & NZ.  'FNDLN' WILL INITIALIZE DE TO THE BEGINNING
; * OF THE TEXT SAVE AREA TO START THE SEARCH.  SOME OTHER ENTRIES OF
; * THIS ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.  'FNDLP'
; * WILL START WITH DE AND SEARCH FOR THE LINE #.  'FNDNXT' WILL BUMP DE
; * BY 2, FIND A CR AND THEN START SEARCH.  'FNDSKP' USES DE TO FIND A
; * CR, AND THEN STARTS SEARCH.
;
FNDLN:  LD      A,H             ; *** FNDLN ***
        OR      A               ; CHECK SIGN OF HL
        JP      M,QHOW          ; IT CANNOT BE -
        LD      DE,TXT          ; INIT. TEXT POINTER
FNDLP:  INC     DE              ; IS EDT MARK?
        LD      A,(DE)
        LD      C,A
        DEC     DE
        ADD     A,A
        RET     C
        LD      A,(DE)          ; C,NZ PASSED END
        SUB     L               ; WE DID NOT, GET BYTE 1
        LD      B,A             ; IS THIS THE LINE?
        INC     DE              ; COMPARE LOW ORDER
        LD      A,C             ; GET BYTE 2
        SBC     A,H             ; COMPARE HIGH ORDER
        JR      C,FND1          ; NO, NOT THERE YET)
        DEC     DE              ; ELSE WE EITHER FOUND
        OR      B               ; IT, OR IT IS NOT THERE
FNDX:   RET                     ; NC,Z: FOUND; NC,NZ: NO

FNDNXT: INC     DE              ; FIND NEXT LINE
FND1:   INC     DE              ; JUST PASSED BYTE
FND2:   LD      A,(DE)         ;* Try to find cr
        CP      CR              ; HIT A CR YET?
        JR      NZ,FND1         ; NO SIR EEE
        INC     DE
        JR      FNDLP           ; REENTER FIND LOOP

; *** TSTV ***
;* Get VRBL storage adrs.
;
TSTV:   RST     RSTIGN         ;* Get next non-blank from (DE)
        CP      '%'             ; PEEK-POKE?
        JR      Z,TSTV1
        SUB     '@'             ; TEST VARIABLE
        RET     C               ; C: NOT A VARIABLE
        JR      NZ,TSTV2        ; NOT "@" ARRAY
; [ab calls as GRAB AND VERIFY SUBSCRIPT routine here ??]
        INC     DE              ; SKIP DA NAME
        RST     RSTPAR          ; GET THE PARM  ;* Get value of () or storage adrs
        ADD     HL,HL           ; CONVERTETH TO BYTES
        JP      C,QHOW          ; REJECT ABSURD VALUES
        PUSH    DE              ; SAVE SCAN PTR
        EX      DE,HL
        CALL    SIZE            ; CHECK FOR VALID SUBSCRIPT
        CALL    COMP            ; do COMPare HL and DE
        JR      C,ASORRY        ; APOLOGIZE FOR RANGE ERR
;
        LD      HL,(TXTUNF)
        DEC     HL
        DEC     HL
        ADD     HL,DE
        POP     DE
        RET

; does %(ADDR) PEEK-POKE CALL here
;
TSTV1:  INC     DE
        RST     RSTPAR          ; GET ADDR  ;* Get value of () or storage adrs
        XOR     A               ; CLEAR CY
        RET                     ; AND GO BACK

TSTV2:  CP      $1B             ; NOT @, IS IT A TO Z
        CCF                     ; IF NOT RETURN C FLAG
        RET     C
        INC     DE              ; IF A THROUGH Z
; IS SECOND CHARACTER ALSO ALPHA?
        LD      L,A             ; SAVE FIRST ONE
        LD      A,(DE)          ; ZAPPED RSTLDE
        CP      'A'
        JR      C,DEVV4         ; IF NOT IN RANGE A-Z
        CP      'Z' + 1
        JR      NC,DEVV4        ; THEN SEARCH
        PUSH    BC
        PUSH    DE
        LD      H,A             ; SECOND CHAR TO H
        LD      B,PARNUM        ; B - ITERATION CTR
        LD      DE,DEVLST       ; DE - SEARCH TABLE
DEVV1:  LD      A,(DE)          ; GET FIRST ENTRY
        INC     DE
        CP      L
        LD      A,(DE)
        INC     DE
        JR      NZ,DEVV2
        CP      H
        JR      NZ,DEVV2
; MATCH FOUND - FIGURE OUT LOOKUP INDEX
        LD      A,B
        ADD     A,$1A
        LD      L,A
        POP     DE
        INC     DE              ; BUMP CHAR PTR
        JR      DEVV3

; MISMATCH - LOOP BACK IF POSS
DEVV2:  DJNZ    DEVV1
; NOT POSSIBLE - RETURN NOT A VAR
        POP     DE
        POP     BC
        DEC     DE              ; BACKUP TO CHAR START
        SCF                     ; SET CARRY
        RET

DEVV3:  POP     BC
DEVV4:  LD      A,L
        LD      HL,VARBGN - 2
        RLCA
        ADD     A,L
        LD      L,A
        LD      A,$00
        ADC     A,H
        LD      H,A
        RET

; ****************************************
; *
; * *** TSTCH *** & *** TSTNUM ***
; *
; * 'TSTCH' IS USED TO TEST THE NEXT NON-BLANK CHARACTER IN THE TEXT
; * (POINTED BY DE) AGAINST THE CHARACTER THAT FOLLOWS THE CALL.  IF
; * THEY DO NOT MATCH, N BYTES OF CODE WILL BE SKIPPED OVER, WHERE N IS
; * BETWEEN 0 & 255 AND IS STORED IN THE SECOND BYTE FOLLOWING THE CALL
; *
; * 'TSTNUM' IS USED TO CHECK WHETHER THE TEXT (POINTED BY DE) IS A
; * NUMBER.  IF A NUMBER IS FOUND, B WILL BE NON-ZERO AND HL WILL
; * CONTAIN THE VALUE (IN BINARY) OF THE NUMBER, ELSE B AND HL ARE 0.
;
;****************************************
;*      RST8    TSTCH                   *
;****************************************
;
TSTCH:  EX      (SP),HL         ;  *** TSTCH ***  ;* Get (caller+1)
        RST     RSTIGN          ; IGNORE LEADING BLANKS  ;* Get next non-blank from (DE)
        CP      (HL)            ;  AND TEST THE CHARACTER  ;* Same?
        INC     HL              ; COMPARE THE BYTE THAT  ;* Next location
        JR      Z,TCH1          ; FOLLOWS THE CALL INTS.  ;* Match!
        PUSH    BC              ; WITH TEXT (DE->)
        LD      C,(HL)          ;  IF NOT =, ADD THE 2ND  ;* Get # of bytes to skip
        LD      B,$00           ;  BYTE THAT FOLLOWS THE
        ADD     HL,BC           ;  CALL TO THE OLD PC  ;* Increment past
        POP     BC              ;  I.E., DO A RELATIVE
        DEC     DE              ;  JUMP IF NOT =  ;* Stay stuck on non-match
TCH1:   INC     DE              ;  IF =, SKIP THOSE BYTES  ;* Next char.
        INC     HL              ;  AND CONTINUE  ;* Bump past # bytes
        EX      (SP),HL        ;* Put return back on stack
        RET

TSTNUM: LD      HL,$0000        ; *** TSTNUM ***
        LD      B,H             ; TEST IF THE TEXT IS
        RST     RSTIGN          ; A NUMBER  ;* Get next non-blank from (DE)
TNM1:   CP      '0'             ; IF NOT, RETURN 0 IN
        RET     C               ; B AND HL
        CP      ':'             ; IF NUMBERS, CONVERT
        RET     NC              ; TO BINARY IN HL AND
        LD      A,$F0           ; SET B TO # OF DIGITS
        AND     H               ; IF H>255, THERE IS NO
        JR      NZ,QHOW         ; ROOM FOR NEXT DIGIT
        INC     B               ; B COUNTS # OF DIGITS
        PUSH    BC
        LD      B,H             ; HL=10*HL+(NEW DIGIT)
        LD      C,L
        ADD     HL,HL           ; WHERE 10* IS DONE BY
        ADD     HL,HL           ; SHIFT AND ADD
        ADD     HL,BC
        ADD     HL,HL
        LD      A,(DE)          ; AND (DIGIT) IS FROM
        INC     DE              ; STRIPPING THE ASCII
        AND     $0F             ; CODE
        ADD     A,L
        LD      L,A
        LD      A,$00
        ADC     A,H
        LD      H,A
        POP     BC
        LD      A,(DE)          ; DO THIS DIGIT AFTER
        JP      P,TNM1          ; DIGIT. S SAYS OVERFLOW
QHOW:   PUSH    DE              ; *** ERROR: "HOW?" ***
AHOW:   LD      DE,HOW
        JP      ERROR

; * *** MVUP *** MVDOWN *** POPA *** AND PUSHA ***
; *
; * 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC->
; *       UNTIL DE=HL
; *
; * 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
; *       UNTIL DE=BC
; *
; * 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE STACK
; *
; * 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE STACK
;
MVUP:   CALL   COMP             ; *** MVUP ***  ; do COMPare HL and DE
        RET     Z               ; DE=HL, RETURN
        LD      A,(DE)          ; GET ONE BYTE
        PUSH    HL              ; SHOVEL REGS
        LD      H,B
        LD      L,C
        CALL    STHL            ; MOVE IT [interlaced into TeXT if necessary]
        POP     HL
        INC     DE              ; INCREASE BOTH POINTERS
        INC     BC
        JR      MVUP            ; UNTIL DONE

MVDOWN: LD      A,B             ; *** MVDOWN ***
        SUB     D               ; TEST IF DE = BC
        JP      NZ,MVD1         ; NO, GO MOVE
        LD      A,C             ; MAYBE, OTHER BYTE
        SUB     E
        RET     Z               ; YES, RETURN
MVD1:   DEC     DE              ; ELSE MOVE A BYTE
        DEC     HL              ; BUT FIRST DECREASE
        LD      A,(DE)          ; BOTH PTRS AND THEN
        CALL    STHL            ; DO IT [interlaced into TeXT if necessary]
        JR      MVDOWN          ; LOOP BACK

POPA:   POP     BC              ; BC = RETURN ADDR.
        POP     HL              ; RESTORE LOPVAR, BUT
        LD      (LOPVAR),HL     ; =0 MEANS NO MORE
        LD      A,H
        OR      L
        JP      Z,PPAX          ; YEP, GO RETURN
        POP     HL              ; NO, RESTORE OTHERS
        LD      (LOPINC),HL
        POP     HL
        LD      (LOPLMT),HL
        POP     HL
        LD      (LOPLN),HL
        POP     HL
        LD      (LOPPT),HL
PPAX:   PUSH    BC              ; BC = RETURN ADDR.
        RET

PUSHA:  LD      HL,STKLMT       ; *** PUSHA ***
        CALL    CHGSGN          ; do CHanGe SiGN of HL
        POP     BC              ; BC = RETURN ADDR.
        ADD     HL,SP           ; IS STACK NEAR THE TOP?
        JP      NC,QSORRY       ; YES - SORRY FOR THAT
        LD      HL,(LOPVAR)     ; ELSE SAVE LOOP VAR.S
        LD      A,H             ; BUT IF LOPVAR IS 0
        OR      L               ; THAT WILL BE ALL
        JP      Z,PUAX
        LD      HL,(LOPPT)      ; ELSE MORE TO SAVE
        PUSH    HL
        LD      HL,(LOPLN)
        PUSH    HL
        LD      HL,(LOPLMT)
        PUSH    HL
        LD      HL,(LOPINC)
        PUSH    HL
        LD      HL,(LOPVAR)
PUAX:   PUSH    HL
        PUSH    BC              ; BC = RETURN ADDR.
        RET

; * *** PRTSTG *** QTSTG *** PRTNUM *** AND PRTLN ***
; * 
; * 'PRTSTG' PRINTS A STRING POINTED AT BY DE.  IT STOPS
; * PRINTING AND RETURNS TO CALLER WHEN EITHER A CR IS
; * PRINTED OR WHEN THE NEXT BYTE IS ZERO.  REG. A AND B
; * ARE CHANGED.  REG. DE POINTS TO WHAT FOLLOWS THE CR
; * OR TO THE ZERO
; * 
; * 'QTSTG' LOOKS FOR SINGLE QUOTE, OR DOUBLE QUOTE.  IF
; * EITHER IT PRINTS THE STRING UNTIL MATCHING UNQUOTE
; * AND RETURNS 2 BYTES LATE.
; * 
; * 'PRTNUM' PRINTS THE NUMBER HL.  LEADING BLANKS ARE ADDED
; * IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
; * HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN C,
; * ALL DIGITS ARE PRINTED ANYWAY.  NEGATIVE SIGN IS ALSO
; * PRINTED AND INCLUDED IN COUNT.  POSITIVE SIGN IS NOT.
; * 
; * 'PRTLN' FINDS A SAVED LINE, PRINTS THE LINE # AND A SPACE.
;
PRTSTG: SUB     A               ; *** PRTSTG ***
PTS1:   LD      B,A
PTS2:   LD      A,(DE)          ; GET A CHARACTER
        INC     DE              ; BUMP POINTER
        CP      B               ; SAME AS OLD A
        RET     Z               ; YES, RETURN
        RST     RSTOUT          ; ELSE PRINT IT  ;* Output Char. in A
        CP      CR              ; WAS IT A CR?
        JR      NZ,PTS2         ; NO - NEXT
        RET                     ; YES-RETURN

QTSTG:  TSTCC   $22,QTS2       ;* Char. to check; Jump bias if no match
        LD      A,$22           ; IF DOUBLE QUOTE-PRINT IT
QTS1:   CALL    PTS1            ; PRINT UNTIL ANOTHER
        CP      CR              ; WAS LAST ONE A CR?
        POP     HL              ; RETURN ADDRESS
        JP      Z,RUNX1         ; WAS CR, END OF THIS
        INC     HL              ; SKIP 2 BYTES, THEN RET
        INC     HL
        JP      (HL)

QTS2:   TSTCC   $27,QTS3       ;* Char. to check; Jump bias if no match
        LD      A,$27           ; OR IF SINGLE
        JR      QTS1            ; LIKEWIZE

QTS3:   RET

PRTCHS: LD      A,E
        CP      B
        RET     Z
        LD      A,(DE)
        RST     RSTOUT         ;* Output Char. in A
        INC     DE
        JR      PRTCHS

; *** PRTNUM ***
;
PRTNUM: LD      B,$00           ; B=SIGN
        CALL    CHKSGN          ; CHECK SIGN
        JP      P,PTN1          ; NO SIGN
        LD      B,'-'           ; B=SIGN
        DEC     C               ; '-' TAKES SPACE
PTN1:   PUSH    DE
        LD      DE,$000A
        PUSH    DE
        DEC     C
        PUSH    BC
PTN2:   CALL    DIVIDE          ; DIV HL BY 10
        LD      A,B             ; RESULT 0
        OR      C
        JP      Z,PTN3          ; YES, WE GOT ALL
        EX      (SP),HL         ; NO SAVE REMAINDER
        DEC     L               ; AND COUNT SPACE
        PUSH    HL              ; HL IS OLD BC
        LD      H,B             ; MOVE RESULT TO BC
        LD      L,C
        JR      PTN2            ; AND DIV BY 10

PTN3:   POP     BC              ; WE GOT ALL DIGITS IN
PTN4:   DEC     C               ; THE STACK
        LD      A,C             ; IF SPACE COUNT NEG
        OR      A
        JP      M,PTN5          ; NO LEADING BLANKS
        LD      A,' '
        RST     RSTOUT          ; SPACE OUTCH  ;* Output Space
        JR      PTN4            ; MORE?

PTN5:   LD      A,B             ; PRINT SIGN
        OR      A
        CALL    NZ,OUTC         ; MAYBE - OR NULL
        LD      E,L             ; LAST REMAINDER IN E
PTN6:   LD      A,E             ; CHECK DIGIT IN E
        CP      $0A             ; 10 IS FLAG FOR NO MORE
        POP     DE
        RET     Z               ; IF SO RETURN
        ADD     A,'0'
        RST     RSTOUT          ; AND PRINT THE DIGIT  ;* Output Char. in A
        JR      PTN6            ; GO BACK FOR MORE

PRTLN:  LD      A,(DE)          ; *** PRTLN***
        LD      L,A             ; LOW ORDER LINE #
        INC     DE
        LD      A,(DE)          ; HIGH ORDER
        LD      H,A
        INC     DE
        LD      C,$04           ; PRINT 4 DIGIT [minimum] LINE #
        CALL    PRTNUM          ; do PRinT NUMber in HL
        LD      A,' '           ; FOLLOWED BY BLANK
        RST     RSTOUT          ; Output SPACE in A
        RET

; Tables for some COMMANDS, FUNCTIONS, and RELATIVE OPERATIONS
TAB2:   ITEM    'TV',PUTCD      ; DIRECT-STATEMENT
        ITEM    'MU',PUTMU
        ITEM    '&',PUTIO
        ITEM    'CALL',DOCALL
        ITEM    '.',REM
; [Note: ITEM    '$',DOLLAR for Calculator routine has been deleted] 
        DB      ':'
        TOKEN   $68,TVLIST      ; on :LIST
        DB      ':'
        TOKEN   $74,TOUTPU      ; on :PRINT
        DB      ':'
        TOKEN   $73,TINPUT      ; on :INPUT
        DB      ':'
        TOKEN   $6A,TLOAD       ; on :RUN
        DB      ':'
        TOKEN   $70,TCLOSE      ; on :RETURN
        DB      '*'
        TOKEN   $74,POUTPU      ; on *PRINT
        ITEM    'STOP',STOP
        DEFF    ENDCHK          ; [or DEFLT ?? ab just uses FINISH ??]
;* End list 1
;
;*       FUNCTIONS
;
TAB3:   TOKEN   $78,RND         ; Input FUNCTIONS
        ITEM    'KN',GETPOT
        ITEM    'TR',GETTRG
        ITEM    'JX',GETJX
        ITEM    'JY',GETJY
        ITEM     'KP',GETKB
        ITEM    'PX',PIXFUN
        ITEM    '&',IOFUN
        ITEM    'ABS',ABS
        ITEM    'SZ',SIZE
        DEFF    NOTF
;* End list 2

TAB6:   ITEM    '>=',XPR1       ; RELATION OPS
        ITEM    '#',XPR2
        ITEM    '>',XPR3
        ITEM    '=',XPR5
        ITEM    '<=',XPR4
        ITEM    '<',XPR6
        DEFF    XPR7
RANEND  EQU     $
;* End list 3

; more routines here
;
;* Output A and input into BUFFER
GETLN:  LD      DE,BUFFER       ; *** GET a LiNe ***
GL1:    RST     RSTOUT          ; PROMPT OR ECHO  ;* Output Char. in A
GL2:    PUSH    BC
        PUSH    DE
        PUSH    HL
; PLACE UP CURSOR BLOCK
        LD      C,$55           ; [bb AND ab $AA]
        CALL    CURSE           ; do Draw CURSor
; RETURN CHAR FROM NEXT LINE #
GL2A:   LD      HL,NLLNCT
        LD      A,(HL)          ; SENSE FLAG
        AND     A
        JR      Z,GL2C
        DEC     (HL)
; FIRST TIME THRU?
        CP      $05
        JR      NZ,GL2B         ; JUMP IF NOT
; GET PREVIOUS LINE # AND BUMP IT
        LD      HL,(OLDLN)
        LD      DE,$000A
        ADD     HL,DE
        RES     7,H             ; ALLOW NEG
        LD      (NLLNLN),HL     ; MOVE TO WORKING RAM CELL
; COMPUTE DIVISION SUBTRACTOR
GL2B:   SYSSUK  INDEXW         ;* Get $2F0F+(A*2)
        DW      TBLDIV - 2     ;* to DE

        LD      HL,(NLLNLN)
        LD      B,$00
GL2E:   AND     A
        SBC     HL,DE
        JP      M,GL2F
        INC     B
        JR      GL2E

GL2F:   ADD     HL,DE
        LD      (NLLNLN),HL
        LD      HL,NLLNZS
        LD      A,B
        AND     A
        JR      NZ,GL2G
        LD      A,(HL)
        AND     A
        JR      Z,GL2A          ; YES - JUMP BACK
        XOR     A
GL2G:   ADD     A,'0'           ; MAKE ASCII
        LD      (HL),A          ; SET NONZERO FLAG
        JR      GL2D

; NOTHIN FANCY
GL2C:   CALL    CHKIO           ; GET NORMAL CHARACTER from keyboard
GL2D:   POP     HL
        POP     DE
        POP     BC
        LD      (DE),A          ; STUFF CHAR AS DELIMITER
        CP      RUBOUT
        JR      NZ,GL4         ;* Jp if not ERASE
        LD      A,E
        CP      BUFFER & $00FF
        JR      Z,GL2          ;* Jp if at beginning
        DEC     DE
        LD      A,(DE)
        CP      $68             ; TOKEN TO RUB OUT?
        JR      NC,TOKIN
        CALL    PNOTE           ; do Play NOTE tone for key in A
        LD      A,RUBOUT
        JR      GL1

TOKIN:  PUSH    DE
        CALL    TOKEPT          ; do TOKEn PoinTer returned in HL
TOKER:  LD      A,(HL)
        PUSH    HL
        AND     $7F
        CALL    PNOTE           ; do Play NOTE tone for key in A
        LD      A,$1F
        CALL    VDM             ; do Virtual Display Monitor output
        POP     HL
        LD      A,(HL)
        INC     HL
        RLCA
        JR      NC,TOKER
TOKEQ:  LD      A,RUBOUT        ; [label not needed]
        RST     RSTOUT          ; ECHO ONE RUBOUT CHAR  ;* Output Char. in A
        POP     DE
GL3:    JP      GL2

GL4:    CP      CR
        JP      Z,GL5
        LD      A,E
        CP      BUFEND & $00FF
        JR      Z,GL3
        LD      A,(DE)
        INC     DE
        JP      GL1

GL5:    INC     DE
        INC     DE
        LD      A,$FF
        LD      (DE),A
        DEC     DE
CRLF:   LD      A,CR            ; Carriage Return (and Line Feed)

; SUBROUTINE TO OUTPUT A CHARACTER [to ??] [?? how is this different from OUTCH ??]
;
;*       OUTC (RST $18)
;
OUTC:   PUSH    HL
        PUSH    DE
        PUSH    BC
        PUSH    AF
        LD      D,A            ;* Save the character
        LD      A,(CHMODE)
        CP      $06
        JR      Z,OUTX1        ;* Jp if not *PRINT
        AND     $02
        JR      Z,OUTX2        ;* Jp if not :PRINT
OUT1:   LD      C,D
        RLC     C
OUT2:   IN      A,(SW2)         ; $12 for 300 Baud Interface ??
        AND     $02
        JR      Z,OUT2         ;* Wait for clock high [on down ??]
        LD      B,$0A          ;* Do 10 bits
OUT3:   LD      A,$C0
OUT4:   DEC     A
        JR      NZ,OUT4        ;* Give clock some time
        DEC     B              ;* Count output bits
        JR      Z,OUTX2
        IN      A,(SW2)
        LD      E,A
OUT5:   IN      A,(SW2)
        XOR     E
        AND     $02
        JR      Z,OUT5
        LD      A,E
        XOR     C
        AND     $02
        JR      Z,OUT6
        IN      A,(SW2)
OUT6:   SET     1,C
        RRC     C
        JR      OUT3

OUTX1:  LD      A,D            ;* *PRINT process
        CP      $68
        JR      C,OUT1         ;* Jp if not word
OUTX2:  LD      A,D
        CALL    VDM             ; do Virtual Display Monitor output
        POP     AF
        POP     BC
        POP     DE
        POP     HL
        RET

; SUBROUTINE TO SIMULATE A CHARACTER DISPLAY IN THE ARCADE
; FRAME BUFFER.  THE SIMULATED VDM [Virtual Display Monitor]
; HAS DIMENSIONS 26 CHARS BY 11 LINES.  THE CHARACTER GRAPHICS
; ARE 5 X 7 IN A 6 X 8 FRAME.  ALTERNATE FONT IS USED TO GET THIS.
; THE 64 UPPER CASE ASCII CHARACTERS ARE DISPLAYED BY THIS
; HANDLER.  THE ASCII CONTROL CHARACTERS CARRIAGE RETURN AND
; RUBOUT ARE ALSO PROCESSED BY THIS HANDLER.  CR CAUSES
; THE DISPLAY TO GO TO THE NEXT LINE OF THE DISPLAY, WITH
; SCROLL UP IF NECESSARY.  RUBOUT CAUSES THE CURSOR TO MOVE
; BACKWARDS ONE CHARACTER POSITION.
; CHARACTER TO DISPLAY IS IN A.  THE ALTERNATE REGISTER SET
; IS USED.
;
OUTCH:  LD      L,A
        LD      A,(CHMODE)
        CP      $06
        LD      A,L
        JR      Z,OUTC
; SOME FUNNY GUYS ENTER HERE
VDM:    CP      CR
        JR      Z,VDMOCR
        CP      RUBOUT          ; TRANSLATE TRASH TO ?
        JR      Z,VDM1
        JR      C,FILT1
        CP      $7A
        JR      C,FILT2
FILT1:  LD      A,'?'
FILT2:  CP      $68             ; TOKEN TO PRINT?
        JR      NC,TOKEP        ; JUMP IF SO
; PLAY NOTE FOR THIS CHAR
        CALL    PNOTE           ; do Play NOTE tone for key in A
; NON NEW LINE CHAR - UNWRITE OLD CURSOR
VDM1:   CALL    UCURSE          ; do Undraw CURSor
        CALL    LDVDMC          ; do LoaD VDM Coordinates
        CP      RUBOUT          ; WAS THAT RUBOUT?
        JR      NZ,VDM3         ; JUMP IF NOT
; RUBOUT ENTERED - SO RUB OUT
        LD      A,L             ; GET X
        AND     A               ; IS X =0?
        JR      Z,VDM2          ; YES - JUMP
        SUB     $06             ; NO - BACKUP X
        LD      L,A
        JR      VDMDN1          ; AND JOIN STORE BACK

VDM2:   LD      L,$96
        LD      A,H
        SUB     $08
        LD      H,A
        JR      VDMDN1

; NEW LINE CHAR - DID WE JUST WRAP AROUND
VDMOCR: LD      A,(VDMNLF)      ; CHECK OLD GLORY
        AND     A
        JR      NZ,VDMDON       ; YES - SKIP DIDDLING
        CALL    UCURSE          ; NO - UNWRITE CURSOR
        CALL    NEWLIN          ; GO TO NEXT LINE
        JR      VDMDON          ; AND QUIT

; NORMAL CHARACTER ENTERED - DISPLAY IT
VDM3:   LD      D,A             ; [NEW for Color Basic ??]
        LD      A,(DEVCL1)      ; Foreground Color
        AND     $03             ; MODulo 4
        RLC     A
        RLC     A               ; Move to ON Color position
        LD      C,A
        LD      A,(DEVCL0)      ; Background Color
        AND     $03             ; MODulo 4
        OR      C
        OR      $10
        LD      C,A             ; WRITE THE CHAR as - 0001fcbc
        LD      A,D
        LD      D,H             ; COORDINATES TO DE
        LD      E,L
        LD      IX,ALTFON       ; USING ALTERNATE CHAR FONT
        SYSTEM  CHRDIS          ; IT  ;* Display Character

        LD      A,L             ; ADVANCE X POINTER  ;* Skip a space
        ADD     A,6
        LD      L,A
        CP      $9C             ; END OF LINE?
        JR      NZ,VDMDN1       ; NO - JUMP
        CALL    NEWLIN          ; YES - NEW 1 LINE
        LD      A,$01           ; AND SET NEW LINE FORCED FLAG
        JR      VDMDN2

VDMDN1: CALL    STVDMC          ; do STore VDM Coordinates
VDMDON: XOR     A               ; CLEAR NEW LINE FORCED FLAG
VDMDN2: LD      (VDMNLF),A
        RET

; ROUTINE TO DISPLAY A TOKEN IN FULL FORM
;
TOKEP:  CALL    TOKEPT          ; do TOKEn PoinTer returned in HL
TOKEP1: LD      A,(HL)
        AND     $7F
        PUSH    HL
        CALL    OUTCH           ; do OUTput CHaracter in A
        POP     HL
        LD      A,(HL)
        INC     HL
        RLCA
        JR      NC,TOKEP1
        LD      A,' '           ; PUT SPACE AFTER TOKEN
        JP      OUTCH           ; AND GO HOME via OUTput CHaracter

; SUBROUTINE TO UNWRITE THE CURSOR
;
UCURSE: LD      C,$00
        JR      CURSE           ; do Draw CURSor in Color 0

; SUBROUTINE TO DISPLAY NEW LINE
;
NEWLIN: CALL    LDVDMC          ; do LoaD VDM Coordinates
; IS SCROLL UP NEEDED?
        LD      L,$00
        LD      A,H
        CP      $38             ; [bb and ab use $50]
        JR      NZ,NEWL1        ; JUMP IF NOT NEEDED
; SCROLL UP IS NEEDED
        CALL    STVDMC          ; do STore VDM Coordinates
; COLOR BASIC [non-interlaced] SCROLL MODE
        PUSH    HL
        LD      HL,NORMEM + $08*BYTEPL
        LD      DE,NORMEM
        LD      BC,$38 * BYTEPL
        LDIR                    ; Snap Scroll Up
        LD      HL,NORMEM + $38*BYTEPL
        LD      (HL),$00
        LD      DE,NORMEM + $38*BYTEPL + 1
        LD      BC,$08*BYTEPL - 1
        LDIR                    ; Clear Bottom Line
        POP     HL
        RET

NEWL1:  ADD     A,$08
        LD      H,A
        CALL    STVDMC          ; do STore VDM Coordinates
        RET

; SUBROUTINE TO PAINT CURSOR
; C = DATA TO PAINT 00 OR AA
;
CURSE:  PUSH    AF             ;* Get CY/CX to HL
        CALL    LDVDMC          ; do LoaD VDM Coordinates
        EX      DE,HL
        XOR     A
        SYSTEM  RELAB1         ;* Subroutine 58

        OUT     (MAGIC),A
        EX      DE,HL
        LD      A,C
        LD      BC,$0806
        CALL    BOXPUT          ; do draw a BOX PUT on screen
        POP     AF
        RET

CHKIO:           ; Read a character from keyboard or cassette tape
SENWAI: LD      A,(CHMODE)     ;* I/O flag
        DEC     A
        JR      NZ,XCHKIO      ;* Not 1 = KBD input
        CALL    KEYSCN         ;* 1 = TAP input, chk for abort
        JP      NZ,RINIT       ;* Abort, start over
        LD      HL,(TAPINS)    ;* Get tape input buffer pointer
        LD      A,H            ;* Get extract pointer
        CP      L
        JR      Z,SENWAI       ;* No data yet
        LD      L,A
        LD      H,TAPBUF >> 8  ; $4Exx
        LD      C,(HL)         ;* Get tape data
        CALL    RAMPIT          ; do Increment Tape Buffer pointer
        LD      (TAPEXT),A     ;* Update extract pointer
        LD      A,C            ;* Get byte
        RET

; Old KEYBOARD HANDLER
; No SHIFT KEY ROLLOVER
;
XCHKIO: CALL    KEYSCN          ; MAKE SURE PREVIOUS KEY RELEASED  ;* Get keyboard data
        JR      NZ,XCHKIO      ;* Wait till no key change
; AWAIT DEBOUNCE TIMER COUNTDOWN
        LD      HL,KEYTMR
        LD      (HL),$06        ; SET IT  ;* Set key release timer
LOOPER: LD      A,(HL)
        AND     A
        JR      NZ,LOOPER      ;* Wait for timer to expire
; SAVE BACKGROUND COLOR
        LD      A,(DEVCL0)     ;* Get BC
        PUSH    AF
; ASSUME FIRST LEVEL KEYCODE
        LD      HL,FIRSTL
GETK1:  PUSH    HL              ; SAVE TABLE PTR
; SCAN ONLY FOR SHIFT KEYS
        LD      HL,KTBL4
        LD      DE,$FFEB        ; (-21) ** SIZE OF LOOKUP TABLE  ;* 20 keys+color
        LD      BC,$0414
GETK2:  IN      A,(C)           ; INPUT FROM PORT  ;* Get shift key
        AND     $20             ; SHIFT KEY DOWN?
        JR      NZ,GETK3        ; JUMP IF YEP  ;* Got one
        ADD     HL,DE           ; ELSE TO NEXT TABLE  ;* Back up to previous table
        INC     C               ; AND PORT  ;* Next port
        DJNZ    GETK2          ;* Do all 4 ports
; NO SHIFT KEY IS DOWN - USE WHATEVER WE HAD BEFORE
        POP     HL             ;* Get current no-shift address
        JR      GETK5

; A SHIFT KEY IS DOWN - SAME OLD STORY?
GETK3:  POP     DE              ; DISCARD OLD BELIEFS  ;* Clear stack
        LD      A,(DEVCL0)      ; SET NEW COLOR  ;* Get BC
        CP      (HL)
        JR      Z,GETK4        ;* Jp if same as desired
        LD      A,(HL)         ;* Get desired BC
        LD      (DEVCL0),A     ;* Save it
        CALL    CLICK           ; do short Click
GETK4:  INC     HL              ; SKIP COLOR BYTE  ;* Point to keys
; NOW SCAN FOR ANY 'NORMAL' KEY DEPRESSION
GETK5:  CALL    KEYSCN         ;* Get input
;* Not there, allow different shift key
        JR      Z,GETK1         ; JUMP IF NO KEY DOWN
; WE GOT ONE - CONVERT TO ASCII
        DEC     A               ; BY TABLE LOOKUP  ;* Back to keys 0-23
        LD      C,A
        LD      B,$00
        ADD     HL,BC          ;* Point to conversion
        POP     AF              ; RESTORE COLOR  ;* Get original BC
        LD      (DEVCL0),A     ;* Reset it
        LD      A,(HL)          ; GET CODE  ;* Get key conversion
        AND     A               ; A HLT PERCHANCE?
        JR      Z,INIJMP        ; YEP - RESET  ;* Restart if no code
        CP      $01             ; AN ERROR?
        JP      Z,CHKIO         ; YEP - GO DOIT AGAIN  ;* Meaningless key
; GOOD KEY...
        PUSH    AF             ;* Save key code
        CP      NLLN
        JR      NC,CHKI02      ;* Jp if word
        SYSSUK  INDEXB          ; HL + A [not loaded!] to HL
        DW      DICKY + 7       ; Offset past DICKS MUSIC SYSTEM NOTE LOOKUP TABLE

        INC     A
        JR      NZ,CHKI02
        CALL    CLICK           ; do Click if $FF (GO,ERASE,+,-,0,x,divide)
CHKI02: POP     AF             ;* Regain converted key
        CP      NLLN           ;* Was it GO+10 ?
        RET     NZ
        LD      HL,$0005       ;* Yes
        LD      (NLLNCT),HL     ; SET FLAG AND ZERO SUPPRESS
        LD      A,$0D           ; PASS BACK CR AS FIRST CHAR  ;* Return a CR
        RET

; Old CLICK ROUTINE
;
CLICK:  LD      A,(NEWTMR)     ;* Wait for current note to finish
        AND     A
        JR      NZ,CLICK        ; Finish Previous Note
        LD      A,G0            ; $FD or 253 (not "GO")
        LD      (MUZTON),A
        LD      A,(DEVTEM)     ;* Get note time
        AND     A
        RET     Z               ; Silence if Tempo = 0
        LD      A,$01          ;* 1 beat delay
        LD      (NEWTMR),A      ; Short Click
        RET

; SUBROUTINE TO CHECK FOR HLT KEY WHILE PGM RUNNING
;* Check for PAUSE or ABORT
;
WHATSU: PUSH    BC
        PUSH    DE
        CALL    KEYSCN          ; GET KEY CODE  ;* Get calculator input
        SUB     $02             ; FREEZE?  ;* Was it PAUSE?
        JR      Z,FRZKEY       ;* Yes
        DEC     A
        JR      Z,INIJMP       ;* Jp if HALT
        JR      FRZGBK          ; ELSE GO BACK TO CALLER  ;* Else leave

;* PAUSE: wait for another key
FRZKEY: CALL    KEYSCN          ; SCAN FOR NONZERO KEY TO REL
        JR      Z,FRZKEY
        CP      $03             ; HLT NAILED?  ;* Was it another HALT
INIJMP: JP      Z,INIT         ;* Yes, restart
FRZGBK: POP     DE
        POP     BC
        RET

; SUBROUTINE TO SCAN TINY BASIC KEYBOARD
;* KEYPAD INPUT (all but shift)
;
KEYSCN: LD      BC,$0414        ; B = CNT, C = PORT #
        LD      DE,KEYTRK       ; DE = KEYBOARD MEMORY
        XOR     A
        SYSTEM RANGED         ;* Random number

KYSCN1: IN      A,(C)           ; LOOK AT COLUMN  ;* Raw key number
        AND     $1F             ; ISOLATE THE RELEVANT
        JR      NZ,KYSCN2       ; JUMP IF BITS HIGH  ;* Got one
        INC     C               ; BUMP PORT #  ;* Next port
        DJNZ    KYSCN1         ;* Do all input ports
        XOR     A               ; SET ZERO STATUS
        LD      (DE),A          ; NOTHIN - SAY ZIP  ;* Set last key = 0
        RET                    ;* and leave

; DEPRESSION FOUND - JUMP UP AND DOWN
KYSCN2: DEC     B
        LD      C,$00           ; COME UP WITH BIT #
KYSCN4: RRCA                    ; SHIFT BIT OVER
        JR      C,KYSCN3        ; JUMP IF THE ONE
        INC     C               ; ELSE COUNT UP
        JR      KYSCN4          ; AND TRY AGAIN

; FOUND BIT - ASSEMBLE KEYCODE
KYSCN3: LD      A,C             ; BIT # TO A
        RLCA                    ; * 4
        RLCA
        OR      B               ; COMBINE WITH COL #
        INC     A              ;* Keys 1-24
        LD      B,A
        LD      A,(DE)
        XOR     B
        RET     Z               ; QUIT IF THE SAME  ;* Leave if same as last time
        LD      A,B            ;* Save new value
        LD      (DE),A          ; ELSE UPDATE TRACKER
        RET                    ;*  and leave

; SUBROUTINE TO PLAY A NOTE
;* NOTE OUTPUT
;
PNOTE:  PUSH    HL
        PUSH    DE
        PUSH    AF
        LD      H,A
; WAIT FOR PREVIOUS PARAMETERS TO BE EATEN
PRWAIT: LD      A,(NEWTMR)
        AND     A
        JR      NZ,PRWAIT       ; LOOP
        LD      A,H
        CP      $63
        JR      Z,PNOTDV        ; Down an octave on Divide sign
        CP      $62
        JR      Z,PNOTML        ; Up an octave on Multiply sign
        CP      '+'
        JR      Z,PNOTPL        ; Sharp next note +1 through +7
        CP      '-'
        JR      Z,PNOTMN        ; Flat next note -1 through -7
        CP      '0'
        JR      Z,PNOTZ         ; to Play Note Zero
        LD      HL,DICKY + 7    ; Offset past DICKS MUSIC SYSTEM NOTE LOOKUP TABLE
; Tone STORe routine by A from table at HL  ;* HL+A to HL
TSTOR:  SYSTEM  INDEXB          ; INDEX BYTE (SYSTEM SUBROUTINE)

        INC     A
        JR      Z,PNOTCL        ; on $FF - for CR aka GO  ;* -1 is no sound
        INC     A
        JR      Z,ANSW          ; on $FE - Play Notes 1 thru 7  ;* -2 is number key
        DEC     A
        DEC     A
        LD      (MUZTON),A     ;* Save next note
        LD      A,(DEVTEM)
        LD      (NEWTMR),A
PNOTCL: XOR     A               ; Clear SHARPF  ;* Set for normal notes
PSHARP: LD      (SHARPF),A
LINKB:  POP     AF
        POP     DE
        POP     HL
        RET

PNOTDV: LD      A,OA1
MSTOR:  LD      (MUZMO),A       ; Master oscillator STORe  ;* Set master sound divider
        JR      LINKB

PNOTML: LD      A,OA3
        JR      MSTOR

PNOTPL: LD      A,$01          ;* Set for sharps
        DB      $11             ; does a LD DE,$023E  ;* Skips 2 bytes
PNOTMN: DB      $3E             ; does a LD A,$02  ;* Set for flats
        DB      $02
        JR      PSHARP          ; save as SHARPF

PNOTZ:  LD      HL,MUZTMR       ; Play NOTe Zero routine
        LD      A,(DEVTEM)
        DI
        ADD     A,(HL)          ; add NT to MUZTMR  ;* Increment note timer by one NT
        LD      (HL),A
        EI
        JR      LINKB           ; LINK Back

ANSW:   LD      A,(SHARPF)      ; *** for Dick AiNSWorth ***
        SYSSUK  INDEXW          ; INDEX WORD (SYSTEM SUBROUTINE)
        DW      DICKY

        EX      DE,HL
        POP     AF
        PUSH    AF
        SUB     '1'            ;* Set for proper increment
        JR      TSTOR

; SUBROUTINE TO POINT AT A TOKEN
;
TOKEPT: LD      HL,TOKTXT       ; POINT AT TEXT LIST
        SUB     $68
JOKEP1: RET     Z               ; QUIT IF POINTING AT EM
JOKEP2: BIT     7,(HL)          ; MOVE PAST NEXT WORD
        INC     HL
        JR      Z,JOKEP2
        DEC     A
        JR      JOKEP1          ; LOOP BACK AND CHECK

; DICKS MUSIC SYSTEM NOTE LOOKUP TABLE
DICKY:  DW      NORMAL         ;* Normal note table

        DW      SHARPS         ;* Sharp note table

        DW      FLATS          ;* Flat note table
;
;* FLAT 1-8 TABLE, also NULL and ASCII VALUE NOTE TABLE 0 to 5
FLATS:  DB      $64,$59,$4F,$4A,$42,$3B,$34
;
;* NORMAL 1-8 TABLE, also SCII VALUE NOTE TABLE 6 to 12 & 13 (Carriage return)
NORMAL: DB      $5E,$54,$4A,$46,$3E,$37,$31
        DB      $FF             ; DICKY + 7 + CR

TBLDIV: DW      $0001           ; 1  ;* also ASCII VALUE NOTE TABLE 14, 15
        DW      $000A           ; 10  ;* also 16, 17
        DW      $0064           ; 100  ;* also 18, 19
        DW      $03E8           ; 1000  ;* also 20, 21
        DW      $2710           ; 10000  ;* also 22, 23

;* SHARP 1-8 TABLE, also ASCII VALUE NOTE TABLE 24 to 30
SHARPS: DB      $59,$4F,$46,$42,$3B,$34,$2E

; Each Letter has its own Note offset DICKY + 7 + ASCII
        DB      $FF             ; ASCII 31 (Erase aka RUBOUT) 
; 16 SYMBOLS from Space ! " # $ % & ' ( ) * + , - . /
        DB      $00,$E1,$D4,$C8,$BD,$B2,$A8,$9F
        DB      $96,$8D,$85,$FF,$77,$FF,$6A,$64
; Flags for NUMBERS 0 through 7
        DB      $FF,$FE,$FE,$FE,$FE,$FE,$FE,$FE
; NUMBERS 8 and 9 plus 6 SYMBOLS from  : ; < = > ?
        DB      $2E,$2C,$29,$27,$25,$22,$20,$1F
; AT sign and LETTERS A through Z plus  [ \ ] Up Left
        DB      $1D,$1B,$1A,$18,$17,$15,$14,$13
        DB      $12,$11,$10,$0F,$0E,$0D,$0B,$0A
        DB      $09,$08,$07,$06,$05,$04,$03,$02
        DB      $01,$64,$5E,$59,$54,$4F,$4A,$46
; Ending with Down and Right then Multiply and Divide
        DB      $42,$3E,$FF,$FF

; TABLE OF FIST LEVEL KEYCODES
;* CHARACTER TABLE, NO SHIFT KEYS
FIRSTL:
        DB      CR              ; Go
        DB      EDKEY           ; Pause
        DB      $00             ; Halt
        DB      $63             ; Divide
        DB      '7'
        DB      '8'
        DB      '9'
        DB      $62             ; Multiply
        DB      '4'
        DB      '5'
        DB      '6'
        DB      '-'
        DB      '1'
        DB      '2'
        DB      '3'
        DB      '+'
        DB      ' '
        DB      '0'
        DB      RUBOUT
        DB      '='

; FIRST SHIFT KEY
;* PORT 17 SHIFT KEY (GREEN BACKGROUND)
KTBL1:
        DB      $A7             ; FIRST SHIFT KEY COLOR = Green
        DB      CR              ; (Go)
        DB      EDKEY           ; (Pause)
        DB      $00             ; (Halt)
        DB      $01             ; (EDKEY)
        DB      'A'
        DB      'D'
        DB      'G'
        DB      'J'
        DB      'M'
        DB      'P'
        DB      'S'
        DB      'V'
        DB      'Y'
        DB      $5F             ; Left Arrow
        DB      $5E             ; Up Arrow
        DB      '&'
        DB      '$'
        DB      '<'
        DB      '('
        DB      '#'

; SECOND SHIFT KEY
;* PORT 16 SHIFT KEY (RED BACKGROUND)
KTBL2:
        DB      $5F             ; SECOND SHIFT KEY COLOR = Red
        DB      CR              ; (Go)
        DB      $2F             ; Slash
        DB      $00             ; (Halt)
        DB      $5B             ; Left Bracket
        DB      'B'
        DB      'E'
        DB      'H'
        DB      'K'
        DB      'N'
        DB      'Q'
        DB      'T'
        DB      'W'
        DB      'Z'
        DB      $27             ; Apostrophe
        DB      '.'
        DB      '@'
        DB      ','
        DB      $22             ; Quotes
        DB      ';'
        DB      '%'

; TABLE THE THIRD
;* PORT 15 SHIFT KEY (BLUE BACKGROUND)
KTBL3:
        DB      $0F             ; THIRD SHIFT KEY COLOR = Blue
        DB      CR              ; (Go)
        DB      $5C             ; Backslash
        DB      $00             ; (Halt)
        DB      $5D             ; Right Bracket
        DB      'C'
        DB      'F'
        DB      'I'
        DB      'L'
        DB      'O'
        DB      'R'
        DB      'U'
        DB      'X'
        DB      '!'
        DB      $61              ; Right Arrow
        DB      $60              ; Down Arrow
        DB      '*'
        DB      '?'
        DB      '>'
        DB      ')'
        DB      ':'

; TOKEN KEY
;* PORT 14 SHIFT KEY (WORDS)
KTBL4:
        DB      $77             ; WORDS KEY COLOR = Gold
        DB      NLLN            ; GO+10
        DB      EDKEY           ; (Pause)
        DB      $6A             ; RUN token
        DB      $68             ; LIST token
        DB      $72             ; FOR token
        DB      $79             ; TO token [BB was $77]
        DB      $77             ; STEP token [BB was $75]
        DB      $6B             ; NEXT token
        DB      $6F             ; GOSUB token
        DB      $70             ; RETURN token
        DB      $78             ; RND token [BB was $76]
        DB      $6D             ; IF token
        DB      $69             ; CLEAR token
        DB      $6C             ; LINE token
        DB      $71             ; BOX token
        DB      $6E             ; GOTO token
        DB      $76             ; CLINE token [BB was EDKEY]
        DB      $73             ; INPUT token
        DB      $75             ; COLOR token [BB was $01]
        DB      $74             ; PRINT token

;                    One final Routine here

; SUBROUTINE TO STORE a byte using LD     (HL),A
; [Always non-interlaced, so CALL    STHL could be replaced ??]
;
STHL:   LD      (HL),A
        RET

; 20 Filler Bytes to match original ROM image
        DB      $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
        DB      $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
        DB      $FF,$FF,$FF,$FF  ;* SPARE CELLS

; END OF COLOR BASIC INTERPRETER
